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FOREWORD 


Study 2.5, DO RCA Applications, has been directed at development of 
a data bank management computer program identified as DORMAN. The 
size of the DORCA data files and the manipulations required on that data 
to support analyses with the DORCA program necessitates automated data 
techniques to replace time consuming manual input generation. The 
DORCA program (Dynamic Operations Requirements and Cost Analysis) 
was developed by The Aerospace Corporation for use by NASA in planning 
future space programs. Both programs are designed for implementation 
on the UNIYAC 1108 computing system at the NASA Computing Facility, 
Slidell, Louisiana. 

This volume contains a listing of the UNIVAC 1108 version of the 
DORMAN program. The code printed herein has been compiled, loaded, 
and executed successfully on the EXEC 8 system for the UNIVAC 1108 at 
Slidell, Louisiana. This was accomplished during the month of September 
(1973) using the segment map contained in Volume II of this report. 

In addition to this volume, the following documentation has been 
prepared. 

Volume I Executive Summary- 

Volume II User’s Guide and Programmer's Guide 

Volume III Original Data Bank Listing 

Study 2. 5, DORCA Applications, is one of several study tasks conducted 
under NASA Contract NASW-2472 in FY 1973. The NASA Study Director was 
Mr. V. N. Huff, NASA Headquarters, Code MTE. 

By agreement with Mr. Huff, the DORMAN program will be delivered 
directly to the NASA Computing Facility. 
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,1 DORMAN. BLOCK BLOCK 3 

BLOCK DATA BLOCK 5 

COMMON /BFRS/ IS YN < 2 ,2 0 > , I SYN1 , IT 1 , IT2 , IT3 , FULL , CN1 , CN2,LIN1, LIN2 BFRS1 2 

* ,NW3UF,NBl,N62,ICNi,ICN2 BFRS1 3 

COMMON /BFRS/ 6UF 1 ( l*, 50) , 3UF2 ( !•* , 5 0 ) , A AA < 7 0 Q> BFRS1 *♦ 

INTEGER CNt,CN2,BUFl,BUF2 BFRS1 5 

LOGICAL FULL BFRS1 b 

COMMON /MlSC/cRFLAG.FERR,KARO(lVi ,ACTION<l*t) MISC 2 

INTEGER £RFLAG,FERR,ACTIQN,PRTFIL MISC 3 

EQUIVALENCE <PRTFIL,F£RR) MISC *r 

COMMON /NAMES/ I VE R , ONA ME ( 2) , MODNA M < 21 . BNAME 1 2 > NAMcS 2 

integer gname, mqdnam, bname names 3 

COMMON /FILES/ BASIC, MTAPE, FINAL, SI, S2 FILES 2 

INTEGER BASIC, MTAPE , FINAL, SI, S2 FIlES 3 

COMMON / ReST/TABLc, US tS, FI Lc.,£ NO, GeCK, OOECK , BLANK ,3AICH REST 2 

INTEGER TABLE, USES, FILE, ENO, DECK, DOECK, BLANK, BATCH REST 3 


COMMON/ VCARD/ ILBL (1h> 



BLOCK 

11 

COMMON /WGRK/IIUNT< 3) , IIRW< 3) , IUTdL(3,19> 

, I ACT ( a , 3 ) , nF ileS 

WORK 

2 

OATA (IL8L(I),I 

= !,!•♦) / 



BLOCK 

13 

* bHiDORMA, 6HN 

OATA, 6H 

BANK , 6H , 

fcHVtRSIU, 6HN , 

BLOCK 

1*» 

* 1H , 1H , 1H ,1H 

, 1H ,1H , 

Irt ,1H / 


BLOCK 

ip 

DATA FINAL, BASIC/ 1^,1/ ,PRTFIL/6 / 


BLOCK 

lo 

OATA USEo, bLANK, END / 

6H USES , 6H 

, 6H SEND O / 

BLOCK 

17 

DATA TABLE/6HF 

TA6L/,DECK/6HF OECK/,DQELK/6H$0£CK /,Fi LE/6HF 

FILE/BLOCK 

lb 

DATA bATCH/0/ 




BLOCK 

19 

DATA IUT3L/ 




BLOCK 

20 

* 0,0,0, 1,2,C, 

2,2,2, 

3,2,2, 


BLOCK 

21 

* <,,2,1, 5,3,0, 

6,2,1, 



BLOCK 

22 

*11,2,2, 12,2,2, 

13,2,2, 

1*>2,2, 


BLOCK 

23 

♦21,2,2, 22,2,2, 

23,2,2, 

2<* , 2 , 2 


BLOCK 

2* 

*>25,2,2, 26,2,2 

> 27,2,2 , 

20,2,2 


BLOCK 

25 

* / 




SLOCK 

26 

DATA NF lLES/19/ 




BLOCK 

27 

OATA IVER /lHTEMP/ 



BLOCK 

2b 

OATA IACT/2l*0/ 




G wT 25 

2 

ENO 




BLOCK 

29 



noooooooonoooono 


r-j 


*E LT , I DORMAN • DORMAN 

DIMENSION III ( 3) ,IR( 3) 

INTEGER CONTtN, GENEOL 

INT EGEr CRcATc ,OSE»GPT ION, SAV::, ADD, DELETE, EDIT 
INTEGER CONVtR,RtPLAC,LlST,DONt 
COMMON /MISC/£RFLAG,FERR»KARD( i-») jACTIOMl**) 

INTEGER ERFLAG,F£RR, AC T1QN,PRTFIL 
EQUIVALENCE ( PRTF I L , F£ RR) 

COMMON /FILES/ BASI C ,M T APE , FINAL , 3 1 , S2 
INTEGER BASIC, MTAPE, FINAL, SI, S2 

COMMON / RES T/T ABLE , USES , FI Lt , E NJ ,0 ECK , LOECK , dL ANK , BATCH 
INTEGER TABLt, USES, F IL t , t ND , OcCK , ODcCK , BLANK, bATCH 
DATA INPUT/?/, CRE AT E/oHCRE ATE/ , OPT ION/ fcHOPT ION/, SAV l/hHSAVE/ 

OAT A A0D/3HA00/ , DELETE/ oH DELETE/, EDIT/ AH EBIT/ 

DATA CON VE R/6HC0NVER/, KEPLAC/6HREPLAC/»LIST/**HLIST/ » 0 ONc./ **H DONE/ 
DATA CON IcN/feHCONTtN/, GENE 0L/6HGENEOL/ 

OATA USE/3HUSE/ 

DATA IU/5,Q,C/ 

DATA IR/2,0,G/ 

DATA IF LAG/ 0 / 

main program 

PROGRAMMER - S* WRAY 


RESERVED FlLtS 


TAPE 1 
TAPt % 
TAPE 12 
TAPE 13 
TAPE 1*» 
TAPE 21 
TAPE 2 A 


INPOT OATA BANK 
OUTPUT DATA BANK 
DORCA DATA DECK 
MOD DECKS -INPUT 
BASIC DECK 
INPUT BASIC OECKS 
MuD DECKS - OUTPUT 


DORMAN 3 
DGRMANL3 
DORMANl* 
DORMANl? 
OGRMANlo 
MISC 2 
MiSC 3 
M ISC *, 
FILES 2 
FILES 3 
REST 2 
RtST 3 
DORMAN2U 
DORM AN 21 
OORMAN22 
DORMAN23 
DGRMAN2** 
UGRMAN2? 
00RMAN2o 
00RMAN27 
DGRMAN20 
OGRMANI!^ 
GORMAnSQ 
U0RMAN31 
UGRMAN32 
UORMAN33 
DORMANS** 
UORMAN3? 
D ORMAN 3 o 
OORMAN37 
OORMANid 
DOkMANJB 
DORMANhU 
DORMAN**! 
Dorman** 2 
DORMAN**3 


WRITE (PRT FIL* 5 ) 

5 FORMAT ( 21H 1 — BcGIN GORMAN — ///3 aH Do YOU WISH TO CKhAT t A 

1 F I LE/2 2 H OR TO USc SUCH A FILE/Z0H ENT cR CREATE OR Us£> 

13 WRITE<PkTFIL,15) 

15 FORMAT (2*»H 3 ENTER OPTION REQUEST - ) 

CALL INT 8UF (IU» IR) 

REWIND oASIC 

call INCD (KARO, INPUT) 

IFUFLAG.iMt.O) GO TO 17 
IF(KARQ (1) .EQ. CREATE) GO TO 20 

17 IF(KARO(l) .EQ.1HU ) GO TO 30 
IF(KAROd) .EQ.USE) GO TO 33 
IF( IFLAG.EQ. 0) GO TO 18 
IF (KARO { 1) .ECU 1HO ) GO TO 25 
IF(KAROd) .EC.1HS ) GO TO h 0 
IF ( KARO (1) .tQ.lHA ) GO TO 35 
IF(KAROd) .EQ.1HU ) GO TO 45 
IF(KARO(l> .EQ.1HE ) GO TO SO 
IF (KARO ( 1) . tQ. 1HC ) GO TO 55 
IFtKARU (1) .EQ. IHR ) GO TO 60 
IF(KAROd) .EG. 1HL ) GO TO 65 
IF(KARU(1) . EQ. OPTION) GO TO 25 
IF (KARO d> .EQ. SAVE) GO TO *0 
IF (KAROd) .EQ. ADO ) GO TO 35 
IF(KARO(l) .EG. DELETE) GO TO *5 
IF (KAROC 1) .tQ.EUIT) GO TO 50 
IF(KARD(1) .EQ.CONVER ) GO TO 55 

IF ( KARO d) .EQ.Rc.PLAC ) GO TO 60 

IF(KARDCl) .cG.LIST ) GO TO o5 

IF(KARO(l) .EQ.UGNE ) GO TO 70 

IF(KAROd) .EU.5H0ATCH) GO TO 80 

16 CONTINUE. 

WRITE <PRTFIL,lo) 

16 FORMATION COMMAND NOT ONOcRSTCOQ - PLEASE RETRY > 

IF (ERFLAG .N£ .0) CALL TERM 
ERFLAG=1 


OURMAN^d 
DATAdURMAN*9 
oORMAN?G 
DORMAN? 1 
UURMAN52 
DORMAN? 3 
DukM AN?h 
DORMAN?? 
DoRMAn?6 
DORMAN57 
DORMAN58 
DORMAN59 
DOkmANoO 
DurMANoI 
UURMAN62 
UORMANo3 
DORM ANo** 
D0RMAN6? 
DURMAnoo 
OCRM ANo 7 
D0RMAN66 
DORMAN69 
DORMAN7G 
DORMAN71 
UORMAN72 
OORMAN7 3 
D0RMAN74 
OORHAN7? 
DORMAN7o 
DORMAN77 
00RMAN76 
GQRMAN79 
DORMAN80 
OORMAN81 
00RMAN62 
QORMAN63 




GO TO 100 

DORMANS* 

6 & 

CONTINUE 

DORMANS? 


CALL LISTED 

DORMANSd 


GO TO 100 

QORMAN87 

70 

CONTINUE 

DORMANS* 


CALL TERM 

DORM AN SB 


GO TO 100 

0QRMAN9B 

zc 

CONTINUE 

UORMAN91 


BASIC = 2 

D0RMAN92 


CALL INCST 

QORMAN9 3 


IFLAG = 1 

DORM AN 9* 


GO TO 1G0 

DORMAN95 

25 

CONTINUE 

DORMANBo 


CALL OPT 

OORMAN97 


GO TO ICO 

DORMAN98 

30 

CONTINUE 

U0RMAN9B 


CALL USER (IFLAG) 

DORM AID B 


IFLAG = 1 

DORMA1Q.1 


GU TO 100 

UGRMA102 

<+0 

CONTINUE 

OORhAlO 3 


CALL SAVER 

DORMA1Q* 


GO TO 100 

DGRMA106 

3 5 

CONTINUE 

OORMAlOb 


CALL AOOtR 

UORMAIO 7 


GO TO 100 

DDRMA108 

*♦5 

CONTINUE 

DORM A10 9 


CALL OtLET 

DORMAllO 


GO TO 100 

OGRMAlli 

5 0 

CONTINUE 

DORM A 112 


CALL tD ITER 

DORM All 3 


GO TO 100 

QORMA11* 

5:> 

CONTINUE 

OORMAils 


CALL CON V 

OORMAllfa 


GO TO 100 

DORMA117 

60 

CONTINUE 

OORMA11S 


CALL RE PL 

DORMA1 1 9 



o o o o 


GO TO X 0 0 
6 0 CONTINUE 
GAT CH = 5 
GO TO 1 Q 0 
IOC ERFLAG^O 
GO TO 10 
END 

*tLT»I DORMAN. AUD 

SUB ROUT INE ADD(IN1, IN2,0UT) 

C AOD A DECK ( WHICH RESIDES ON FILE IN2) TO THE DATA FILE (INI) AND 
C PUT EXPANDED DATA ON FILE GuT. 

C 6Y 3.J, GOLD 
C 

COMMON /MISC/ERFLAG,F£RR,KARQ(14> , AQTIGN( 14) 
iNTtGtR tRFLAG,FtRR, ACTION, PRT FI L 
EQUIVALENCE ( PRTF IL , FE RR) 

INTEGER OUT 

INTEGER TYPE, FLAG, TEMP ( 1<7) 

COMMON /REST/TA6LE,U3cS,FlLE,END,0£CK,DDECK,BLANK , BATCH 
INTEGER TAOLE, USES, FILE, END, DECK, DOECK, BLANK, BATCH 

INIT IAlIZl FIlc-S. RcAO FIRST CARD OF NlW DECK ANO VERSION CARD FROM 
DATA FILE. 

FLAG - 1 
Rc NINO INI 
REWIND OUT 
ERFLAG = 0 
CALL INC U ( KARO , IN 2) 

K0UNT2 = 1 

IF (ERFLAG. NE.C) GO TO IOC 
TYPE = 5H8ASIC 

IF (KARD(t) .EQ.USES) TYPE = 3HMOO 

IF (KARD(l) .NE.UOECK) GO TO 110 

CALL EXTRAN ( K ARO ( 7 ) ,K ARO ( 9) ) 

WRITE (PRTFIL, 1C) KARO (2) , KARO(3> 


0GRNA12Q 
C0RMA121 
D0RMA122 
0URMA123 
DORMA12", 
00RMA127 
D0RMA126 
ADD 3 
ADD ? 
ADD 6 
ADO 7 
ADD d 
ADO 9 
MISC 2 
MISC 3 
MISC * 
ADD 11 
ADD 12 
REST 2 
REST 3 
ADO 1* 
ADO 15 
ADO 16 
ADD 17 
ADD 16 
ADD 19 
AuO 20 
ADD 21 
ADD 22 
ADD 23 
ADO Zh 
AOD 26 
ADD 2b 
ADO 27 
ADD 26 
ADD 29 



o o o 


10 FORMAT ( 16H0 ADD DECK NAMED ,2A6,13H TO DATA FILE) 

CALL OUTCQ (KARD, PRTFIL) 

IF ( <KAR0(2) .EQ.KARU(5)> .AND. (KAR0(3> .EQ.KAR0(6) I > GO TO 150 
CALL INCO (TcMP, INI) 

IF (ERFLAG.NE.O) GO TO 120 
KOUNT1 = 1 

CALL OUrCJ(TEMP,OUT> 

C 

C INSERT NEW ENTRY INTO TABLE OF CONTENTS AT BEGINNING IF IT IS A MOD 
C DECK, AT END IF A BASIC DcCK. 

C VERIFY THAT NEW DECK NAME IS NOT ALREADY IN TABLE OF CONTENTS, 

C IF NEW DcCK IS A MCu DECK, VERIFY THAT THE DECK IT USLi lo ALkEADY 
C ON THE DATA FILE. 

C 

FLAG = 2 

IF ( TYPE . EQ. 3HMOO) CALL OUTCO ( KARD, OU T ) 

NEED = 0 
LASTM = 0 
NTC = 0 

30 CAcL INCO( TEMP, INI) 

IF (ERFLAG, NE. 0) GO TO 120 
KOUNT1 = KOUNT1+1 
IF (TEMPI 1) .EQ. END) GO TO R0 
CALL OUTCU(TtMP,OUT> 

NTC = NTC+1 

IF (TEMPU) .EQ.USES) LASTM = NTC 

IF ( (KAkD(2> .EQ.TEMPC2)) .AND. (KARD(3) .tQ.TcMP(3))) GO TO 130 
IF ( ( KARD ( 5 ) ,EQ.TEMP(2) ) .AND. (KARG16) .£Q.T£MP(3) ) ) NtEO = NTC 
GO TO 30 

40 IF (TYPc.EQ.5H BASIC) CALL OUTC D (KARD , OUT) 

CALL OUTCD( TEMP, OUT) 

IF ((NEED. EQ.0) .AND. (TYPE. EQ.3HHO0) ) GO TO 140 
COPY ALL MOD DECKS FROM INI TO OUT 


non ooo non 


NDECK - 0 

50 CALL INCOCTcMPjINlI 

IP CtRPLAG. Nc.O) GO TO 120 
K0UNT1 = KOUNT1 + 1 
CALL OUTCG(TEMP,OUT> 

IF CTEMPll) »h£ « END) GO TO 50 
NOtCK = NDtCK+1 

IF CNOcCK.LT. LASTM) GO TO 50 
TRANSFER NEW DECK ONTO CUT FILE 


FLAG = V 

CALL OUTCO(KARG,OUT) 

60 CALL INCOCKARD, J.N2) 

IF (EkFlAG.NE.O) GO TO 100 
K0UNT2 = KOUNT 2 +-1 
CALL uUTCO(KARG,OUT> 

IF (KAkO(l) .N l.cNO) GO TO 60 

COPY REST OF OATA FILE, INCLUDING $£NO OF FILE CARO, ONTO OUT FILE 
FLAG = 5 

60 CALL INCO ( T EMP , INI) 

IF (cRFLAG.Nc.C) GO TO 120 
KOUNT 1 = KOUNT 1+1 
CALL OUT CO (TEMP, OUT) 

IF (TEMP(i) .NE.END) GO TO oO 

IF (T t MP(2) .Nc.EHF FILE) GO TO 60 

RETURN 


ERROR STOPS 


100 HRITc (FERR, 105) 
105 FORMATC 23H0 ERROR 
GO TO 200 

110 WRITE (FERR, 115) 


REAOING 


ADO 

6o 

ADO 

67 

ADO 

66 

ADO 

65 

AOO 

70 

ADD 

71 

ADD 

72 

AOO 

73 

ADO 

7*» 

AOO 

75 

AOO 

7 o 

AoO 

77 

ADD 

76 

ADD 

79 

ADO 

60 

ADD 

61 

AOO 

62 

ADD 

83 

ADO 

6h 

AuD 

63 

ADD 

66 

ADD 

67 

ADD 

60 

ADD 

69 

AuD 

90 

ADD 

91 

AOO 

92 

ADD 

93 

ADD 

9*, 

ADD 

*3 

ADD 

9o 

ADO 

97 

ADD 

96 

ADD 

95 

ADO 

100 

ADD 

101 


FILE IN2) 


u O U +400000 


11? FORMAT ( 37HGFIfT.il CARD On FILE IN2 IS NOT *UECK ) 

GO 10 200 

120 WRITE (FEKR, 12?) 

12? FORMAT ( 23HQERRUR READING FILE INI) 

GO TO 200 

130 WRITE { FERR* 13?) KAR0(2», KARO(3) 

135 FORMAT < %5HGNAMc. CONFLICT IN ADDING NEW CtCK TO Floe I UU 

* bH NAME ,2A6,3oH ALREAUY EXISTS IN. TABLE OF CONTENTS) 

GO TO 200 

1%0 WRITE (FERR>1%5) (KARU(I), 1=1,6) 

1%5 FORMAT { 52HQDECK TO BE ADDED OsES DECK NOT IN TABLE uF CONTENTS/ 

* ? X , b Ab ) 

GO TO 2 Q 3 

163 WRITE (F’EKR, 165) 

155 format ( i/hooeck uses itself) 

200 ERFLAG = 1 

AUVANCc FlLc IN2 TO END OF CURRENT DECK 
ERFLAG - Q 

210 IF (KARO ( 1 ) . EQ . END) GO TO 220 
CALL INCD(KAkD,IN2) 

KOUNT2 = K0UNT2 ♦ 1 
IF (tRFLAG.cU.G) GO TO 210 
WRITE (FERR, 105) 

220 ERFLAG = 1 
RE TUR N 
END 

LT , I DORMAN. ADDER 

SUBROUTINE ADDER 

ADD CONTRULER 

PROGRA M.’icR - S. NRAV 


AoD 

ID 2 

ADD 

103 

ADD 

10-* 

ADD 

10? 

AoD 

10 o 

ADD 

13 7 

ADD 

13b 

ADD 

109 

ADD 

11C 

ADD 

111 

AOD 

112 

ADD 

113 

AoD 

11% 

ADD 

115 

ADD 

lit 

ADO 

117 

ADD 

116 

ADD 

119 

ADD 

12 0 

ADD 

121 

ADD 

122 

ADD 

123 

ADD 

12% 

ADD 

12? 

ADD 

12o 

ADD 

127 

ADD 

126 

ADD 

129 

AoD 

130 

ADock 

S 

ADDlR 

5 

ADDER 

o 

adder 

7 

ADUtk 

d 

AuDck 

9 

AooER 

10 



o o o o o 


I 

vO 

I 


1 

5 


10 


15 


20 


XELT.I 


COMMON /HiSC/tRFLAGf FdRrt»KA<*0( 1*) , ACT ION (14) 

M liU 

2 

XNTtGtK ckFLAG , F£RR , ACTION, PkTF XL 

M ISC 

3 

cOUIVALcNCc; (PRTFIL ,FtRK> 

M 1 _>G 

*♦ 

DATA IX/0/ 

ADDER 

12 

IF(lX.tQ.O) RE WIN J 21 

ADDEk 

13 

IX = 1 

ADUcR 

l*t 

HRi T E ( PRTFIL » 5) 

A DOER 

Is 

FORMAT ( 1 2H iNT E R iNfUF/lZH OR 3ASIC/15H OR 

HOD DECK/9H READY AD Jt.K 

lo 

- ) 

ADDER 

12 

CALL iNCOCKAROti) 

AdOcR 

13 

IF<KARO(l) .£Q.5HBASIC ) GO TO 10 

AuDER 

19 

IF ( KARD C 1) . EQ. 6rif1GO Od > GO TO 15 

A^DER 

20 

IF ( KARO ( 11 « Nc . 5rt INPUT ) GO TO 1 

ADOcK 

21 

CALL ADO X ( 2 1 ) 

Au Jl.R 

22 

RETURN 

ADDER 

23 

CONTINUE 

ADDER 

2* 

REWIND 1*. 

AUOtR 

2s 

CALL AOG X (1<») 

ADDER 

2 o 

RETURN 

ADQtfv 

27 

CONTINUE 

ADDER 

23 

WRITc (PRTFiL»2G) 

ADDER 

25 

FORMAT ( >,2H IS MOO DECK GENERATED OR INPUT ON TAP 

E 11/9H RlADY - ) AOOtR 

30 

CALL INCO ( K AKD , 5 ) 

ADDER 

31 

Mi = 13 

ADUlR 

32 

IF(KARIHI) .EC.5HINPUT > Ml = 11 

ADDER 

33 

REWIND Ml 

ADUcR 

3*» 

CALL AuUX(Ml) 

AOOtR 

35 

Rt TURN 

AD JER 

3c 

END 

ADDcR 

37 

uOKMAN. AOOX 

ADDX 

3 

SUJROUTINE ADC X (INOKF) 

AD Jx 

s 


ADDX 

o 

NTROLS ADD OPERATION 

ADUX 

7 


ADDX 

0 

JGRAMMEK - S. WkAY 

ADDX 

9 


AUUX 

10 



I 





COMMON /KEST/TAbLE, OSES, FI l£, END , DECK, DOECK , BLANK , BATCH 

REST 

2 




INTEGER TABLE, US£i, FILE, END, DECK, ODECK, ELAN K, BATCH 

REST 

3 




COMMON /FILcS/ BASIC, M TAPE , FINAL , $1 , S2 

FILES 

2 




INTEGER DAiiC, MTAPt, FINAL, SI, S2 

FIcES 

3 




COMMON / M ISC/c F FLAG »FEkk, KARD( 1<*) , ACT ION <10 

MibC 

2 




INTEGER ERFLAG,FERR,ACT1GN,PRTFIL 

MiSC 

3 




EQUIVALENCE < P RT F I L , FE RR> 

RISC 

4 




INTEGER OUTOK»GO»OGNE» IU ( 3 ) ,IR(3> 

ADDX 

1 *T 




DATA IR/2,2,2/ 

AoDX 

is 




CAT A GO/2HGO/,DONt/-fHDONt/ 

ADDA 

lo 


c 



ADDX 

17 


c 


INPUT DECKS ARE ON TAPE21, TtMF OUT FILE IS TAPE 22 

ADDX 

16 


c 



AODX 

19 




IC = 0 

AODX 

20 




IX = 1 

AODX 

21 




OUT DK = 22 

ADDX 

22 



10 

CONTINUE 

ADDX 

23 




NO = 0 

ADDX 

2 h 

1 



IU(1) = 3 

ADDX 

23 

H- 

o 



IU( 2) = INOKF 

AODX 

2 o 

1 



IU ( 3 ) = OUTOK 

ADDX 

27 




CALL INT 8UF ( IU , 1 R) 

ADDX 

26 




CALL INCO (KARD, INOKF) 

ADDX 

29 




IF ( tRFLAG • N£ « 0 ) GO TO 1000 

ADDX 

3 J 



12 

REWIND OUTOK 

ADDX 

31 




IF (KAkO(l) .EQ.OOECK) GO TO 20 

ADDX 

32 




WRITE ( PRT FIL ,11) 

ADDX 

33 



11 

FORMAT (27H PLEASE ENTER NAME FOR DECK ✓ 9H REAOY - ) 

ADDX 

3*+ 




CALL INCO < AC1 ION, 5) 

ADDX 

35 




ACTION (3) = ACT ION (2) 

AODX 

3o 




ACTION (2) = AClION(l) 

ADDX 

37 




ACTION (1) = uOECK 

ADDX 

36 




CALL OUTGO (ACTION, OUT DK) 

AODX 

3 9 



21] 

CONTINUE 

ADDX 

*0 




IC = IC + 1 

ADDX 

4l 




NO = 1 

ADDX 

*♦2 


39 WRITE ( PRTFI L , 4 G ) K A«u ( 2 > , KARO ( 3) 

*♦0 FQRMATdtH DECK FOUND - » 2 A6/1 7H uNTcR OK OR SKIP/9H RtADT 
CALL INCD (ACTION, 5) 


IF (ACTIO N(l) .EQ.2HGK ) GO TO 45 
IF(ACTIONU) .NE.4HSKIPI GO TO 39 
nl CALL INCO (KAROilNDKF) 

IF ( ERFL AG • ME . G ) RETURN 
IF (KARO ( 1) .Nc.DUECK) GO TO h1 
GO TO 20 
L5 CONTINUE 

CALL OJ ICO (KARO, OUTOK) 

IC = IC «■ 1 

21 CALL INC J ( KARU , I NO KF) 

ACTI0N( 2) =KAkO(2> 

IF(ERFLAG.Nt.C) return 

IF ( KARO ( 1 ) • Nc. • t NO ) GO TO *♦ 5 
23 CONTINUE 

00 22 I = 1,14 

22 KAkO(I) = 3LANK 
KARO ( 1) = END 

K ARC ( 2) = DECK 

CALL OUTCO(KAkC,OUT JK) 

KARO ( 2) = FILL 

IX = 2 

IF (ACTION (2) .EQ.JECK) GO TO 30 

1000 W* I T£ (PRTF1L, 1001) 

1001 FORMAT ( 5 1H cOF FOUND - IF ACCEPTED, 
♦CADY - > 

CALL INC J (ACTION, 5) 

IF( ACTION( 1) .cQ.OONt) RETURN 
IF (ACTION(l) .NE.GO ) GO TO 1000 
EkFLAG = 0 

30 CONTINUE 

WRlTt ( PRTFI L , 31 ) IC 

31 FORMAT < 16, 2QH CARUh fUUNO IN DECK) 
IC - 0 


AujX 43 
- ) AUOX 44 

AODX -tv 
AuDX 4b 
AOOX 4 7 
AUOX td 
AOOX 49 
AODX 50 
AUOX j\ 
AUOX 52 
AUOX 53 
AOOX 5 4 
AODX 55 
AOOX 5b 
AOOX 57 
AODX 5d 
AODX 59 
AODX o J 
AODX 61 
AuDX 62 
AODX 63 
AOOX 64 
AUOX 65 

AOOX 66 
AUDX o/ 
AODX 06 

ENTtR GO, GTHtKWlEE DONE /9H RAJDX 69 

AODX 7 C 
AUOX 71 
AOOX 72 
AOOX 73 
AUDX 7 1 
AODX 7 a 
AODX 7o 
AuDX 77 
AOOX 7b 



on o ooooo 


SI = iiASIC + 1 

IF ( Si . G T • 3) SI = 2 

REWIND SASIC 

RE WINO 0 J TDK 

REWIND St 

IUC1) = SASIC 

IU ( 2 ) = OUT OK 

IUC3) = SI 

CALL IN rS'JFUU, iRI 

CALL AUDI JASlC,uUTOK,Sl) 

IF ( ERFL AG . N£ . C ) RETURN 

SASIC - Si 

RcTURN 

END 

*ELT,I UORMAN « ASsGN 

SU3R0UT IN£ ASSGN (I) 

ISSUE ASG CARO FOR FILE I 

PROGKAFMtR - S. WRAY 

COMMON /MISC/tK.FLAG ,FEkK,KA^D( It) ,ACTIGN(1A> 
INTEGER £RFLAG,F£RR, ACTION , PRTF I L 
EQUIVALENCE ( P RTF I L , FE RR) 

WRITE (FRTFIL,&) I 

5 FORKAT(28H WMAT Io YOUR NAME FOR TAPE ,i3/9H READY 
CALL INCD (ACTION, 5) 

IF(ERFLAG.NE»0) return 

ISSUE ASG ANO USt CAROS 


RETURN 

END 

*ELT,I DORMAN. CKSYN 

SUBROUTINE CKSYN (ICOl , IC02, N1 , N2) 
C 


AOOX 79 
AUOX 80 
ADOX 81 
AOOX 82 
AOOX 83 
AUDX 8* 
AUOX 8b 
A uDX do 
AUOX of 
ADOX 88 
AUOX 8S 
AOOX 9(J 
AUDX 91 
AOOX 92 
ASSGN *♦ 
ASSGN b 
ASSGN i 
AoSGN a 
AoSGN 9 
ASSGN 10 
AoSGN 11 
M ISO 2 
HiSC 3 
MISC 

ASSGN 13 
ASSGN 1*» 
ASSGN 13 
AsSGN 1 u 
ASSGN 1? 
ASSGN 18 
ASSGN 19 
AsSGN 2u 
ASSGN 21 
CKSYN 3 
CKoYN b 
CKSYN o 
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ICOl IS CARD IN 3UFFER1 CKSYN 7 
ICQ2 IS CARD IN 3UFFER2 CKSYN 6 
N1 IS INDEX TU. PROPER SYNC CARO CKSYN 9 


N2 = 0, 00 NOT INCREMENT N1 
N2 = 1, OK TO INCREMENT N1 
COMMON /9FRS/ 

ISYN(2,2C) 

IF ICOl Ok 1CD2 IS GE TO SYNC 
RcScT TO SYNC CARD VALUES 

PROGRAMMER I VOIT 

ISYN1 = N1 

ICOl = ISYN( 1 , I SYN1) 

ICD2 = ISYN(2,ISYN1) 

IF (N2.EQ.0J RETURN 
N 1 = Nl+1 
RETURN 
END 

ELT , I DORMAN. CLOSE 

SUBROUTINE CLOSE (I> 
cNDFILE I 
REWINO I 
RETURN 


CKSYN 1G 
CKSYN 11 
CKSYN 12 
CKSYN 13 
CKSYN It 

CARD THEN CKSYN 15 

CKSYN 16 
CKSYN 17 
CKSYN 16 
CKSYN 19 
CKSYN 20 
CKSYN 21 
CKSYN 22 
CKSYN 23 
CKSYN 2h 
CKSYN 25 
CKSYN 26 
CLOSE 
CLOSc o 
CLOSE 7 
CLOSE o 
ClOsE 9 


END 

ELT,I DORMAN. COUNT 

SUBROUTINE COUNT ( NF ILE ) 

COMMON /REST/T A 3Lc , USES , FI L£ , END , DECK » OOECK , BLANK »6ATCH 
INTEGER TABLE, USES* FI LE, END , DECK , OOECK , BLANK, BATCH 
COMMON /MISC/ERFLAG,FERK,KAR0(1.,> ,ACTION(1 l) 

integer erflag,ferk, action, prtfil 
EQUIVALENCE (FRTFIL, FERR) 

PROGRAMMcR - S. WRAY 


CLOst 10 
COUNT 3 
COUNT 3 
REST 2 
REST 3 
MISC 2 
M l SC 3 

MISC h 
COUNT a 
COUNT 9 
COUNT 10 
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■ 


REWIND NFIlE 
ACTION (1) = 6HNO NAM 

ACTION (2) = OHt 

Du 1 1 = 3 » b 
1 ACT ION ( I) = BLANK 
1=1 

CALL 1NCD( KAkD > NFILE) 

IF(ERFL AG.NE.C) RETURN 
IF (KARD(l) .NE.DDECK) GO TO 5 
ACTION (1) = KARO (1) 

ACTION (2) = KARO (2) 

ACTION (3) = K Arc.0 (3> 

ACTION in) = KARO ( •♦) 

ACTION (5) = KAhO (?) 

ACTION (6) = KARO (6) 

5 CALL INCO (KAkO, NFI lE) 

IF(ERFLAG.Nc.G) GO TO 13 
1 = 1 + 1 

IF(KAkD( 1) .NE.ENO) GO TO ? 

IFiKAKu(2 ) .NE.FILl) GO TO ? 

1C WRITt ( PkT FIL > 1 5) NfILt> (ACTION(LL) ,LL = 1,o) ,1 

15 FORMAT (5HDTAPtjI3tOH WITH ,bA6,9H C ONT AX NS , 1 7 , bH CARDS/ ) 

Rc. TURN 
END 

*£LT,I JORMAN.OElCD 

SUBROUTINE OlLCu (IS?) 

IS? IS THE SYNC CARD 

WRITE DELETE CARD 
AND POSITION BUFFER IF REQUIRED 

COMMON /3FRS/ ISYN(2,2C) , I S YN1 , 1 T 1 , 1 T 2 , I T 3 , FULL , CN1 ,CN2 , L INI , LI N2 
* y N W 6UF > NB 1 1 NB 2 > 1 CN 1 y I CN2 
COMMON /dFR^/ OUF 1 ( 1 *+, 50) , 3UF 2 ( 1 A , 5 0) , A A A ( 7 0 0 ) 

INTEGER C N 1 » CN2 » BUF 1 » d UF 2 


COUNT 11 
COUNT 12 
COUNT 13 
COUNT 1, 
COUNT 1? 
COUNT id 
COUNT 1 7 
COUNT Id 
COUNT 13 
COUNT 2 i) 
COUNT 21 
COUNT 22 
COUNT 23 
COUNT 2*t 
COUNT 2? 
COUNT 2o 
COUNT Z7 
COUNT 2d 
COUNT 23 
COUNT 3d 
COUNT 31 
COUNT 32 
COUNT 33 
COUNT 3-» 
OLcCO 3 
OcLCO ? 
OcLCU o 
oELCO 7 
OcLCO 6 
OtLCD 3 
OElCu 10 
JtLCO 11 
dFRSl 2 
BFRS1 3 
oFRSl •* 
BFRil 5 
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LOGICAL FULL 

bFRil 

o 

INTcGcR F I N 1 » F I N 2 

utLCO 

13 

EQUly/ALtNCt ( FOUT , 1 T 3) 

UtLCO 

1*» 

EQUI VALENCE (FlNljITl) 

UtLCO 

1 3 

EQUIVALENCE (FIN2,IT2) 

UtLCO 

lo 

INTEGER FOUT 

OELCD 

17 

KK = ISP-2 

UtLCO 

It 

KKK - LlNl - 1 

UtLCO 

19 

NRITt(FuUT,61) KKK i KK, 

OELCD 

23 


UtLCO 

21 

MOVE UUFFER 1 UP 

UtLCO 

22 

IF SYNC IS OUT OF BUFFER 

OELCD 

23 


UtLCO 

2* 


UtLCO 2s 
DtLCD 2 d 
U tLCO 2 7 
UtLCO 26 
DtLCD 29 
utLCU JO 
&NT13 1 
UtLCO 32 
UttCD 33 
OELCD 3** 
UtLCO 33 
DtLCD 3o 
DtLET 3 
OELtT 3 
OtLtT o 


DcLdtS OtCKS OtLtT 7 

OtLtT 6 

PRO GR AMMEk. - S* RkAY UcLiT *3 

Ut.Lt. T 10 

DIMENSION IU(3) , Ik ( 3) UtL£T 11 

COMMON /MISC/tkFLAG,F£RR,KARD( 1 h) » ACTIOnU*) MlSC 2 

iNTtGEk £RFLAG,FtRR,ACTlGN,PRTFlL MISC 3 

c OU I V Al t NCt ( P RTF I L j Ft kk) MISC **. 


NCARJS = KK - KKK + 1 
CN1 = Cl\il t NCAkGS 
LlNl = LIN1 + NCAkuS 
IF(CNl.LT.wai) RETURN 
ISP = LIN1 

LlNl = LlNl - NCARUS 

CALL RESTORtbUFl, ISP,nD1,FIn1, LIND 

CN1 = 1 

LlNl = ISP 

RETURN 

31 FORMAT ( 7HSGELETE, I 13, 110) 

END 

tLT,I OOHMAN»GELcT 

SUBROUTINE OtLtT 
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COMMON /FILcS/ BASIC, MTAPt, FINAL , SI ,S2 
INTEGER BASIC, MTAPE , FINAL, SI, S2 
DATA IR/2,2,2/ 

WRITE ( PRT FIL » 5) 

5 FORMAT (27H WHAT DECK IS TO BE QclcTtQ/SiH REAOY - ) 

SI = BASIC +1 

IF(S1«GT .3) Sl=2 

IU(1> = 5 

IU ( 2 ) = BASIC 

IU ( 3) = SI 

CALL INTBUF( IU, 1R) 

CALL INCU (ACTION, 5) 

CALL DELETE < ACT I ON , B ASIC, S 1> 

IF(ERFLAG.NE.O) RETURN 

3ASIC=Si 

return 

ENO 

F £ L T ji I DORMAN .DELETE 

SUBROUTINE OEL E TE ( N A ME , INI , OUT) 

COPY DATA FROM FILE INI TO FILE OUT WITH NAMED DECK DELETED. 
PROGRAMMER - 6. GOLC 

COMMON /rtISC/ERFLAG,FERR,KARO(l*) ,ACTIOMl*t) 

INTEGER ERFLAG,FERR,ACTION,PRTFIL 
EQUIVALENCE (PRTFIL ,FE RR) 

INTLGcR OUT 

INTEGER FLAG, NAME (2), T£MP(1h) 

EQUIVALENCE ( KARO ( 1 ) , T EMP ( 1) ) 

COMMON /RtST/TAbLc,UStS,FlLt,tND,DECK,DDtCK,QLANK , BATCH 
INTEGER TABLE, USES, FILE, END, DECK, DDECK, BLANK, BATCH 

INITIALIZE FILES AND COPY VtRSION CARD. 

FLAG = 1 
REWIND INI 


FILcS 2 
FILES 3 
DELET 14 
OcLcT 1 :» 
DELET 10 
DELET 17 
DELET IB 
DELET IB 
DELET 2(1 
DELET 21 
DELeT 22 
OELtT 23 
DELeT 2*, 
DELET Z'j 
DELET 26 
DcLeT 2 7 
DELET 2 A 
DELETE 3 
DELETE :> 
DELETE 6 
DELETE 7 
OELETc ti 
OcLeTe 9 
MISC 2 
MISC 3 
MISC 

0ELETE11 
0ELETE12 
0ELETE13 
REST 2 
REST 4 
DELE Tel:? 
UtLc.Tc.io 

Delete l z 
GELeTelB 
QcLe Tel 3 
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REWIND OUT 
tRFLAG - 0 

WRi TE (PRTFIl, 1C) NAME 

10 FOR MAT ( 19HG DELETE DECK NAMED ,2A6,15H FROM DATA FiLc) 

CALL INCD<TcMP,INl) 

IF (txFLAG.NE.O) GO TO 120 

KOUNT1 = 1 

CALL OUTCU(TtMPjOUT) 

COPY TABLc OF CONTENTS. VERIFY THAT DECK TO BE DELE TED IS IN TABLE 
OF CONTENTS AND NOT REQUIRED BY ANY OTHER DECK. 

FLAG - 2 
INDEX = 3 

NT C = 0 

30 CALL INCO ( TEMP, INI) 

IF (ERFLAG.NE. 0) GO TO 120 

KOUNT1 = KQUNTl-ri 
IF (TEMP(l) .EQ. END) GO TO *0 
NT C = NTC+1 

IF ( (TEMP (2) .EQ.NAMEtD) .AND. (TEMP (3) . EQ* NAME ( 2) ) I GO TO 35 
IF <(TtMP(5> *tQ.NAME(l >) .AND. <T£MP(6> *tG*NAME(2> ) ) GO TO 1 a0 
CALL OU T CO (TEMP, OUT ) 

GO TO 3 G 

35 index = ntc 

GO TO 30 

*♦0 CALL UUTCO( TEMP, OUT) 

IF (INDEX. EQ.0) GO TO 130 

COPY ALL DECKS FROM INI TO OUT UNTIL REQUIRED DECK IS FOUND. 

FLAG = 3 

50 CALL INCO(TEMP, INI) 

IF (ERFLAG.Nt.O) GD TO 120 
KOUNT1 = KOUNT1 ♦ 1 

IF ( (TEMP(l) . EQ. DUE CK) .AND . (TEMP (2) . EQ* NAME (1) ) 


DtLc.Tt.2C 
U£LlT£ 21 
0cLtTt22 
QELETE23 
Dc.Lc.TE2h 
OEL c7c25 
DELETES q 
UcLt Tc.27 
UELlT£ 26 
D ELcTt.29 
Dc.LcTc.3u 
DELc TE31 
DELE Tc 32 
DcLc Tc33 
DcLcTE 3-» 
Oc.Lc.1c35 
UcLcTEJg 
DcLc Tc37 
OcLc TE36 
UElET £39 
DELcTchO 
OELcTchI 
OcL£TcL2 
D£LcTch3 
OtLc Tchh 
DELE TEhv 
DcLcTcho 
GcLeTcR 7 
DELE Tend 
DcLE7Eh9 
DELcTc. 50 
UcLcTcBl 
DELE T E52 
DcLcTc.53 
DELETE 5 h 
D cLcTtSs 



ooo ooo ooo 


* . AND . <TcMP( 3 ) .EQ.NAME ( 2 ) ) ) GO TO 55 

CALL OUICU{TEMP,OUT) 

GO TO 50 

SPACE PAST OLD DECK 

55 flag - ■» 

K 0 UNT 2 = KOUNTl 
60 CALL INCD( TEFP, INI) 

IF (ERF LAG . NE , G ) GO TO 120 
KOUNTl = KOUNT 1 *■ 1 
If <TEi 1 P(l) .Nc.ENO) GO TO 60 
K 0 UNT 2 = <OUNTl-KOUNT 2 +l 
WRITE (PRTFIL, 70 ) KGJNT 2 
70 F 0 RMAT( /lit) , lLH CAROS UcLtTtO) 

COP/ REST OF OATA FILE, INCLUDING $cNO OF FILE CARD, ONTO OUT FILE 
FLAG = 5 

60 CALL INCQ ( TEMP , IN L) 

IF (ERFLAG ♦ Nt» G ) GO TO 120 
KOUNTl = K 0 UNT 1+1 
CALL OUTGO ( TEMP, OUT ) 

IF (TEMP(l) ♦NE.ENO) GO TO 60 

IF (TtMP(Z) .Nt.fcHF FILE) GO TO 80 

RETURN 

ERROR STOPS 


DELc.Tc. 5 o 
UELc TE 5 7 
GELcTcSo 
Uc.Lc.Tc. 5 S 
DELE Tco 0 
OELE Tc 6 L 
QElE TEoE 
DELE T Eb 3 
UElETEo 4 
UcLcTcOb 
DcLc T cdo 
U cLc Tcb 7 
ucLc Tco 6 
DclcTcoS 
DcLc Tc 7 0 
UELETE 71 
0 £cETE 72 
DELE TE 7 3 
OEcE 1 E 7 - 4 
OELETE 76 
DcLc.Tc7o 
CclcTE77 
QELETE 76 
OELe IE 7 9 
OcLETEdU 
UELETcd 1 
UcLcTcdE 
0 cLcTcd 3 
DcLETEdC 


12 Q WRITE (FERR , 12 5 ) 

125 F 0 RMAT( 23 HGERR 0 R REAOING FILE INI) 

GU TO 200 

130 WRITE (FERR, 135 ) NAME 

135 FORMAT ( 22 H 0 DECK TO tic UELETEO (, 2 A 6 , 36 H) 
*F CONTENTS) 

GO TO 200 


UclE T c35 
UcLETE66 
U£L£Tt87 
UtLcTcdd 

IS NOT LISTED IN TAULc UOELETE 89 

UcLt Tc9 0 
DElETc 91 
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ItO WRITt {FERR,lv5> NAME, TtMP{2) , T£MP(3) 

US FORMAT ( 2 1H0 DECK TO 8£ DELETED (2AB,22H) IS REQUIRED BY DECK 2A6) 

C 

200 ERFLAG = 1 
RETURN 
ENO 

*£LT,I DORMAN .OIFOEC 

SUBROUTINE DIFDEC ( FIN 1 , FI N2 , FO UT , F SYN) 

FSYN WILL CONTAIN THE SYNC CAROS 

THE SYNC SEARCH WILL B£ ABANDONED IF THE CARO 
NUMBER IS GREATER THAN THE SYNC CARD 
THEN THE SYNC CARD NUMBERS WILL BE USED 

COMMON / BUFFER/MA X 

COMMON /8FRS/ ISYN(2,20) , I S YN1 , I Tl , IT2 , IT3 , FULL # CNl , CN2 , LlNl » LIN2 
♦ ,NWBUF,NB1,NB2,ICN1,ICN2 
COMMON /BFRS/ cJUF 1 ( 1-+, BO) , B JF 2 ( it, 50 ) , AAA ( 7 00 ) 

INTEGER CNl,CN2, 3UFl,BUF2 
LOGICAL FULL 
INTEGER FlNi » F IN2 » F OUT 
INTEGER FSYN 


0ELETE92 
DELETE93 
DELET £9*» 
0ELETE9B 
0ELETE96 
OEL&TE97 
OIFDECM3 
QIFucCMB 
DIFDECMo 
OIFOECM7 
DIFDECMO 
U IFDtCMB 
OIFOEC10 
OIFOECU 
DIFUEC12 
bFRSl 2 
BFRSi 3 
BFRil <♦ 
BFRSl 5 
BFRSl o 
OIFOECU 
OIFDEola 


OIFutClo 


THIS ROUTINE u£Tc.RMI Nt S THE DIFFERENCE BETWEEN QcCKS ON TAPES FIN1 DIFDEC17 

OIFBEC16 

AND FIN2. T He DIFFERENCE IS EXPRESSED AS A MOD OtCK TO CQNWER DIFDEC 19 

OIFDtC2J 

THE DECK ON FIN1 TO THE DECK ON FIN2. THE MOD DECK IS WRITT£N0IF0tC2t 


ON FOUT. 

DIMENSION IUNT<3) ,1RW(3> 
INTEGER COUT(lA) 

NW3UF = 50 
MAX= NWBUF 
I T 1 = F I i«l 1 


O IF0EC22 
DIFUEC23 
0IF0EC2-* 
DIFOEC2? 
UIFQEC2© 
0IFDtC27 
iilFQtOZa 
D 1FU EC2 9 
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1T2 = F IN2 

UIFUEC30 

I T 3 = FOUT 

0IF0EG31 

0IF0EC32 

READ SYNC CAROS 

0 IF0EC33 
DIF0EC3-, 

IT* = FSYN 

0IFU£u3d 

CALL SYNCJSCIT*) 

0 IF0£C3o 
0IF0EC3 1 

INITIALIZc UNIT., 

GIFOEG36 
UIFutG3 '■} 

ISYN1 = 1 

01 FDtC<*.B 

IUNT (l)-FIMl 

OIFGEO^i 

IUN 1 (21 = F I N 2 

OIFutC*.2 

IUNT (3) = F 0 U T 

0IFuEC*3 

IRW(l) = 0 

D IFOEC** 

IRW ( 2) = 0 

OIFOLCty 

IRW ( 3) = 1 

0 IF0tC*»o 

CALL INI8UF (IUnT,IRW) 

D IFOto* 7 

CALL FlLBUF(l,NUl»Nki3UF,BUFl,FINl> 

0 IFo£C*B 

CALL FlL3UF(l,Nd2,NW3UF,BUF2,FIN2) 

DIFOEC^B 

FULL = . TRU£. 

QlFOtuB J 

CN1 = 1 

0 IFDEC31 

CN2 = 1 

QIFulC»2 

L I N 1 = 1 

OIFliElBB 

LINE = t 

OIF ucCp* 

00 5 1=1, Lh 

OIFuLC3a 

COUT (I) = 1H 

iJIFOtCbo 

COUT(l) = 0UF1 (1,1) 

01FutCi>/ 

GOUT (21 = 3UF 2(2,1) 

OlFOtCdd 

COU 7(3) = BUF2(3,1> 

uIFutCd j 

COU 7 { *) = oH USES 

0 IFuECo u 

COUT ( s) = 6UF 1(2,11 

OlFuLCoi 

COUT (6) = 3UF 1 ( 3,1) 

DIFOtCo2 

CALL cX TRAN ( COUT ( 7 > ,C OUT ( 9 ) ) 

U IFOEC63 

CALL OUTCO (COUT , o) 

OIFutCo* 

CALL OUTGO (COUT ,FGuT) 

oiFoecbs 
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1C CN1 = CN1+-1 
CN2 — CN2 + 1 
LI.N2-LIN2 + 1 
LiNi=LlNl+l 
12 CONTINUE 

If (CNi.GT .N31) GO TO 100 
IF(CN2.GT.NB2) GO TO 130 
00 13 1=1,1* 

IF <0UF11I,CN1) .NE.3UF2 (I,CN2) ) GO TO 2C 
15 CONTI NUt 

FULL =. FALSE. 

GO TO 10 
2C CONTINUE 

CHECK SYNC CAROS 

PRIOR TO SEARCH FOR MATCH 

N2 = 0 

CALL CKS YN ( ICM » ION 2,ISYN1» N2J 
500 COnTINUc. 

IF ( CLIN1.LT.1CN1) . ANO. (LIN2.EQ.lCN2) ) GO TO 600 
IF ( (LINl.tQ.lCNl) . AND, (L1N2.LT. ICN2) ) GO TO 620 
IF ( ( LIN1 , £Q . 1CN1) .AND. (LIN2 .EQ . ICN2) > GO TO 630 
IF (LIN1.GT.1CN1) GO TO 630 
IF (LIN2.GT.1CN2) GO TO 630 
GO TO oh Q 

OELtTE 

600 CALL DtLCD (ICN1-1) 

GO TO 10 

InSEkT 

620 CALL INSERT (ICN2-1,0) 

GO TO 10 


UlFOLCou 
GIFUt067 
OiFuECod 
CIFO£Co9 
OIFOEC7 0 
UIFOtC/ 1 
OlFoEC 7 2 
OIFOEC73 
OlFutC 7 <♦ 
OIFOEC7> 
OIFOEC76 
0 IFO tC77 
OIFOtC7o 
UiFotC79 
DIFutCd j 
OxFOECdl 
DIF0EC32 
OIFJtCdS 
OIFCECtW 
uiFoecd^ 
OlFuEOio 
OIFOEC67 
0IF0EC66 
OIFOEC69 
U1FOEC9G 
O XF0EC91 
o IF0EC92 
OIFOEC93 
0IF0EC9- 
0IFDEC9P 
UIFO£C9o 
01F0E697 
oiFOtcya 
OiFOEC 99 
OIFOtiaO 
O IFQtlO 1 



c 

c 

c 

6 30 


c 

c 

c 

□ AO 


100 


120 


150 


170 


200 

5000 


*tLT, 


GET NeXT SYNC CAROS 

N2= 1 

CALL CKSYNC 1CN1 , ICN2 , I SYN1 ,N2) 

GO TO 5C0 

FIND iYNC 

CONTINUE 
CALL SYNCl 
GO TO 12 
CONTINUE 

IF ( bUFl ( 1 , NB1 ) . £Q.6H#ENO 0) GO TO 120 
CALL FILSUFll, Nul ,N hBUF,BUFl,FlNl) 

CN1 = .1 
GO TO 12 
CONT INUE 

IF ( CN2 « GT » N32) GO TO 200 
CALL INScRT (No2-l , 0 > 

GO TO 200 

IF ( 3UF2 ( 1*N02) .£Q.6Hi£ NO O) GO TO 170 
CALL FIL3UF ( 1 * NB2 ,NW3UF ,BUF2, FIN2) 

CN2 = 1 
GO TO 12 
CONTINUE 

IF ( CN1 « GT « NOl) GO TO 200 
CALL OtlCO (NBl-i) 

CONTINUE 

WRITE (F OUT *5000) 

FORMAT! 12H SEND OF DECK/ 12H iEND OF FILE) 

ENO FILE FOUT 

RETURN 

£N0 

DORMAN, tDITOK 

SUBROUTINE EDITOK(IN,MOD,NOUT) 


DIF0E1Q2 
UIFDti 0 3 
O IFOE10 4 
DIFDE105 
OIFDtlOo 
0IFDE107 
uIFDElOa 
OIFDtlOB 
OIFOtll Q 
DlFUElli 
UIFOE112 
DIFOEli 3 
DIFOtll* 
DIFOEli ? 
DIFOEllo 
DIFUE117 
0IFDE118 
DIFDE119 
DIFDE120 
DIF0E12 1 
OIFDE122 
DIFDE123 
DIFul12h 
DIFDE 12? 
U IFUt 12o 
DIFDE127 
01F0E12O 
0IF0E125 
DiFOtl3Q 
DIF0E131 
DIFOt 1 32 
u IFuEl 33 
0 IFD £13*t 
DiFu£135 
EDI TDK 3 
cDITDK a 



I 

ro 

w 

i 


COMMON /MISC/ERFL 
INTEGtk ERFLAG.FE 
EQUIVALENCE <PRTF 
DIMENSION IN8<1*) 
DIMENSION IcM<7,9 
DIMENSION NTEM3 ( 1 
INTEGER OENO 
DATA I EM /6HED1T 


I6H0ECK N 
2 6HE 01 TDK 
26HNGN-NU 
36HEDITQK 
36HLINE N 
‘♦6HI0ITDK 
*6HL INE N 
56ME0IT0K 
56HM00S R 
bbHtGITGK 
66HCCNTIN 
76HEQITDK 
76HIGELET 
doHEOITOK 
S6HN0 OAT 
96HE0ITDK 
ioHCONTlN 


bHAMES N 
bH - 
oHMcRIC 
oH 

6H0. IS 
bH - 
6HQ . IS 
6H - 
oHlMAIN 
6H - 
oHUATION 
oH 

6HE LINE 
bH 

6HA M AT C 
oH 

6HUATI0N 


AG » FERR»K 
RR, ACTION 
IL,FERK> 

, MOD B ( 1** 

> 

o) 

UK » 6H - 
,oHOT COM 

ioHlNTRY 

» 6H0U T OF 

, SHOUT OF 

1 6 H- END 

i b H CARO 

,6H NOS. 

. 6 HH ON * 

»6H CARO 


AR0(l4) »ACTICN<l*t> 

» PRTFI L 

), NftMlCm), NT EM2 ( 16) 


bHPATIBL»bH£ 
bHIN LIN,bHt NO. 
6H RANGE y bH 
6H ORDER > 6H 
bHOF IN y oHGECK 
SHOUT 0F,6H ORDER 
oHOUT OF »6H ORDER 
bHALTER , bHCARD 


6HN0T EN,6HTtRED / 


PROGRAMMER- G. H. TIMPSON 


PREScT VARIABLES 


ERFLAG= 3 
I = - 1 
Ml NO=0 
OEND-O 
I £ = 0 
NEF = Q 


MISC 2 
MlSC 3 
MISC 

EDITOR 7 
EDITOR ti 
tQI TDK 9 
tDITORia 
EDIT0K11 
EDIT0K12 
EDITDR13 
t DIT OKI*. 
EOITOKlb 
E0IT0K16 
c 01 T OKI 7 
£ Dll ORIS 
EDITOR! 9 
EDITOR 2D 
C.DIT0K2 1 
E0ITUK22 
EJIT0R23 
EDIT UK2*. 
EUIT0R2b 
t01TCR2b 
E0ITDK27 
cOlT 0K2 6 
E0ITLK29 
E0IT0K3G 
E0IT0K31 
E0IT0K32 
EOIT0K33 
cOI T 0R3 1 
cOlTOKJb 
£Uil0K3o 
EDIT GK37 
EUI TGK3a 
EDIT0R39 



c 

C READ H CARO FROM HOC FILE 

C 

10 NTL=NT 
N T = 1 

IF ( MENU • EQ • i) GO TO 12 
CALL INCU(MOOct>MOD) 

IF ( ERFL AG . ME . 0 ) RETURN 
IF< MOUb < 1) ,E0.6HiENu 0)GU Tu 13 
IF(MG06(1) . ECU 6HSIN SER) GO TO 1 <t 
IF(M008(1> .EQ.6 H*ALT£k)GO TO Is* 

IF ( HOOG ( I) . EQ. 6HJ0ELET) GO TO 16 

12 GO TO 20 

13 M £ N G = 1 
GO TO 20 

1-t NT = ^ 

GO TO 20 

15 NT = 3 

GO TO 20 

16 NT -2 
C 

C TEST FOR FIRST TINE 

C 

20 IF(I.NE.-i) GO TO 22 
N S W = 1 
GO TO 600 
C 

C TEST FOR PREVIOUS MOO OUT OF RANGE 

C 

22 IF ( I £. EQ • 5 ) GO TC 703 
C 

C TEST FOR END OF IN FIl£ 

C 

2h IF(C£NC. £O.0)GO TO 33 

C 

C TEST FOR CONTINUATION INSERT CARO 


C.01T GK + b 
fcOITGK<*l 
EU1T0K«*2 
tOITOK<*3 
cDI TDK 44 
EDITDK45 
EGITOK46 
EGITGK-+7 
£ Oi TOK<+o 
cOITGK4* 
C.GITGK5C 
EDI TDKS1 
EDI T0KS2 
EOITOKS3 
EOITDKa*» 
EDIT OK55 
E0I1DK56 
EUi 1 OK:>7 
c. DIT0K56 
EDITDK5U 
E0IT0K6C 
cUITOKol 
c DI T GK62 
EDIT DKo3 
EOiTOKof 
EDIT GKap 
tDI T LiKob 
tOITOKb? 
EOITQKod 
EGITDKo* 
EUITOK/U 
cDI T GK7 1 
E0IT0K72 
EOITOK73 
fc GITDK7 >♦ 
£UITDK7^ 



o o o ooo noo ooo ooo 


IF { IE «NE ♦ 3 ) GO TO 52 
If (NT.EQ.l)GO TO 800 
It = 5 

GO TO 700 

TEST FOR END OF MOO FILE 

30 IF ( MEND • EQ* 0) GO TO 40 
NSW = 5 
GO TO 500 

TEST FOR CONTINUATION INSERT CARO 

h0 IF(KT.Nc.1>GG TO 60 

TEST PREVIOUS MOO CARO AND ERROR CONDITION 

IF (It.NE.O)GO TO 62 
IF<NTL.N£.3)GL TO 620 
50 NSW=2 

GO TO 5 C 0 

PYPASS CONTINUATION CARDS 

52 I £■= 9 

GO TO 700 

GET LINE/CARD NUM3ERS 
63 IE= 0 

ENCODE* 64, 62,NT£M1) MODS 
62 FORMAT ( l<tAo) 

DECODE ( 8 J » b*+ > N TEM 1 ) NT E(12 
oh FORMAT (6(A6jA4)) 

GALL VALUc (NTEH2 ( 3) ,VN1,I£R> 


EGIT0K76 
EQITOK77 
EOITDK78 
E0IT0K7 9 
E0ITDK6Q 
EDITDK6I 
tUiT0K32 
EDITOK63 
tOITOK6>* 
EDITDKdp 
cOITOKdo 
EDITDK67 
EDITDK63 
E0IT0KO9 
EDITDK90 
EDIT UK 91 
EDIT DK92 
EDI TUK93 
£UI TOK94 
EDITDK9? 
tOITQiOo 
C.OITDK97 
EDITUK90 

edit uk99 

lOITDIOO 
EDI TQ13I 
EDITD102 
EUITO103 
cOITOlO* 
EuITOiOa 
EoITOlOb 
cDITDlC 7 
cUITOiQa 
EDIT0129 
EDITDltfl 
t OI TO 1 1 1 



IF(IER«EQ«0) GO TO o 6 


C 

C St T ERROR FLAG - ILLEGAL line entry 

c 

66 IE-2 

GO TO 7 G 0 
do N 1 - V N i 
NS W= 3 
C 

C TEST FOR FILE POSITION 

C 

70 iFd.LT.NDGO TO 603 
IF( I.Eii.Nl) GO TO 60 
C 

C SET ERROR FLAG - MOO uUT OF OROck 

C 

It =i * 

GO TO 700 
C 

C TcoT TYPE OF CAKO 

C 

6 0 Go TO t 62 » 6<* » IIS » al) »NT 
C 

C. CONTINUATION INStRT CA Ru IS ILLcGAL 

C 

6 2 I E = 6 

GO TO 7 0 C 
61 N S W = 6 

GO TO 600 
C 

C TEST VALIDITY OF HZ 

C 

tw CALL VALUE C nTl M 2 ( 5) »VN2»ItR) 

IF UER.EQ.-DGG TO to 
IF (Ick.GT.Q)GO TO 66 
N2= VN2 


£ U1 T011.2 
tOITUllS 
EDITOll* 
EDITG11. 2 
EOITDllo 
EQiTDll. 7 
EoITOUd 
c.oITOll'p 
c.01 T0i2u 
E0ITU121 
E0ITU122 
E0ITG123 
luITGIZh 
c.01 T012? 
EUI TU12c 
£01 TGI 2 7 
tUIT0126 
l G 1 T u 1 2 j 
EuXTGISG 
E0ITG131 
EOITD132 
E0IT0133 
EUlTolJt 
CUIT013? 
£OITbl3o 
C.0ITD137 
£01 T Dl 36 
c. 0 1 T u 1 3 3 
EOI TG1*#3 
£ 0 1 T G 1 % 1 
c.oilGli-2 
tOITGl*3 
EuI 1 G1 h>*» 
t PIT 01 Hr 2 
£011 GIhmp 
EUITGW 



IF ( N2.L T • N1J GO TO 90 
6 5 IT S W = e 

GO TO 600 
66 N2=N1 

GO TO 65 
C 

C DELETE LINES OUT OF SEQUENCE 

C 

90 IE= 7 

GO 70 700 
C 

C TEST FOR END OF DELETE STRING 

C 

10J IF <I.L£.N2)GO TO 85 
GO TO 610 
C 

k c ALTER OPTION 

-J c 

1 110 c.NC Out ( 6e » 62 » NTtM 1) INb 

DECODE ( SO » oe » NT EMI) nTc. M3 
J0112K=1,16,2 

IF(NTEM3(K) • N£ • NT CM 2 ( 5 ) ) GO TO 112 
IF<MEMSCK + 1> .NE.NTEM2 <o> ) GO TO 112 
GO TO 11C 
112 CONTINUE 
It = o 

GO TO 7 C 0 

lie NT£M3(K) =NTEh2 (7) 

NT EM3 ( K + l) = NTt M2 ( 8) 
cNCOOt( 80 ,6 h,NTcM1) Ml m3 
OECOuE( 8 h, o2,NTti11) i NO 
GO TO d 10 
C 

C TEST FUk RANGE lRROR 

C 

120 IF (OENO.EQ.O)GO TO 70 


tUITDlno 
luITG1h9 
tOi TOISO 
£01 TD151 
EOITG162 
EDITUlsi 
c OI T 01 >>♦ 
LOITOlSy 
EOI TOlSo 
EuITOlS/ 
tOIT0156 
tOITDl^y 
t Ul TO lol) 
tOITOlul 
cOi T Ulo2 
EUlTUloS 
tUlTulbn 
EDIT Dlop 
EOI I Oloo 
EOITulo7 
E0ITD166 
C.OIT Dlo9 
EUITD170 
EUITD171 
Eul TD172 
tUITui73 
EUITUl7e 
EDIT 01 7 ? 
EOI I 0176 
EJITD177 
£OIT017a 
EDIT 0179 
tOI TUlSi) 
tuITOlfll 
E0ITO1S2 
EDIT 016 3 



ooo ooo oooooo non 


i£=3 

GO TO 700 


TEST FOR NAME MATCH 

130 IF< M008(5) .NE.1N3(2) )G0 TO 1*0 
IF(M0U6(o) »NE.IN8(3))GQ TO 1*0 
M JOB ( 4) =1H 
MODS ( 5) = 1H 
H00 0(6) = 1H 
NSW=2 
GO TO 600 
14 Cl IE=1 

GO TO 7 C 3 

WRITE IN RECORD ON NOU T 

50C CALL QUTCD<InB,NOUT> 

READ IN RECORD - TEST FOR 4 ENOOFDECK 

603 1=1+1 

CALL INCO ( iNb, IN) 

IF(ERFLAG.NE.C) RETURN 

IF < INB< 1) . EQ.6HSEND 0)OEND = l 

GO TO < 133,300,120, 100 ,24, 13) , NSW 

PRINT ERROR MESSAGE 

700 WRITE ( FERR, 702) (I£M(J,I£) , J=1 , 7) , MOOB 
732 FORMAT ( 1H ,7A6,3H - /1X,14A6) 

NEF = 1 

GO TO ( 820,610 , 613 , 610 , 610 , 320,610, 310,610) , I E 
TEST FOR ENO OF EDITING 


t JlTDi3*» 
tDITOlttJ 
E JiTDldo 
E0IT0187 
EDIT Ol 3 3 

tonoiaa 

EOITD190 
EDIT 0191 
ED1T0192 
EQIT0193 
EDITD1SI4 
E0IT019B 
c. 01 T 01 9o 
E0IT0197 
E0IT0193 
EDIT 019 9 
EDIT0200 
E0IT023 1 
cUlTD202 
EOITO203 
EDI T023 4 
EDITD20? 
£ 0IT020o 
c0ITD207 
C.DI TD203 
cOIl 0209 
t OIT02 10 
EDI T0211 
Eul 1021 2 
EDITD213 
£011021* 
£ JIT 021 ? 
c0IT021o 
EOI T 0217 
E0IT0213 
EUIT0219 



o o o o o 


I 

\D 

I 


800 CALL OUTCO(MODB,NGUT) 


EDITD22J 


810 IF ( MtNG .tQ.OJGO TO 13 EDITD221 

IF ( CENO (£0*0)00 TO 10 C.0IT0222 

820 cRFLAG=NEF c0iT0223 

RE TURN EOITQ22* 

ENL) EDI T 0225 

*ELT,I DORMAN . EJI TER tOITtR 3 

SUBROUTINE EDI TER EDITER S 

EDI TER 6 

BUILDS EDIT DECKS LDiTtR 7 

cDITER 8 


PROGRAMMER - S. WRAY 

COMMON /M 13 C/ERFLAG ,FERR,KARQ< 1 -*) ,ACTICN( 1 A> 

INTEGER cRFLAG,FcRR,ACT 10 N, prtfil 
EQUIVALENCE < PRTF I L , Fl RR) 

COMMON /FILES/ bASI C » M T APE , FI NA l » SI » S 2 
INTEGER BASIC, MT APE , FINAL, Si, S 2 

COMMON / NA MwS/ I Vc R , 0 NAME ( 2 ) , MGONAM ( 2 ) , BN AMt < 2 ) 

INTEGER GNAME ,MDDNAM, 3 NAME 

COMMON /REST/TAbLE,USES,FILE,EN 0 ,DECK, 00 £CK, 3 LANK , BATCH 
INTEGER T ABLE, USES, FILE, ENG, DECK, DOECK, BLANK, BATCH 
iNTiGcR BMOO(S) ,CMOO(t>) 

DIMENSION IU( 3 ),IR( 3 ) 

DATA IU,IR/ 0 , 0 , 0 , 2 , 2 , 2 / 

WRITE (PRTFIL, 5 > 


cUlJfcK 9 
EuITERlO 
MiSG 2 
MISC 3 
MISG *♦ 
FILES 2 
FlLtS 3 
NAMcS 2 
NAMES 3 
nEST 2 
REST 3 
EOIlcRl^ 
EDIT tkio 
E01TEM7 
LDlTtKld 


FORMAT ( 2 1H BEGIN cUlT UPER AT ION/ 23H ENTER NAME UF NEW utCK/BH REAUEDITER1B 


* Y - ) 

' CALL INCO (KARO , 5 ) 
DO 10. 1 = 1, l*t 

io act ion ( I ) = blank 

ACTION(l) = ODECK 


EDITER20 
E0ITER21 
cDIT tR22 
LOITER23 
EDI T ER2 4 , 


ACT XQN< 2 ) = KARD(l) 
ACTION (3) = KARO( 2 ) 

ACTION* *> = USES 
Wrti T E (PRTFIL,15) 


EDI! £R2i> 
EDIT £R2o 
EOITER27 
E0ITER28 



1 

CO 

0 

1 


E.Q . BN mME ( 2 ) ) ) GO TO 25 


1 9 

2 0 


C H 

2 5 


2 0 


FORMA T ( 2 9H ENTER NAME OF REFERENCE 0ECK/9H READY - > 
CALL INCO l KARO , 5) 

FINAL - 1 * 

ACTI0N(5) = KARO ( 1) 

ACT ION (6) = KARO (2) 

CALL tXTRAN ( ACT I ON < 6 ) , ACT £ ON< 1 J > ) 

IF ( ( KARO ( 1 ) .EQ.uNAME(l)) *ANQ. (KARO (2) 

IF(6NAMfc (1) .£Q. u) GO TO 2* 

WRITE (PRTFIL,2J> 

FORMAT (28H REFtKENCE DECK I b NOT 5ASIC/29H DcbTRUCT 
♦UIREU/16H EMTcR YES OR NO/ 9H READY - ) 

CAlL INCO (KARD,5> 

IF (KARO (1) «cGU 2HNG) Re. TURN 
IF (KARO (1) .NE.3HYES) GO TO 19 
CALL USe(ACTICN<5> ) 

REWIND FINAl 
MOONAM( 1) = ACT ION( 2 ) 

MODNAfK 2) = ACTIONl 3) 

WRITE < PR T FIL , 3 G ) 

FORMAT ( lbrl ENTER MOL CARDS/25H ENTER DONE WHtN 


COITER29 
EDIT ER30 
EOITEkJI 
EDIT Ek32 
EDIT Ek 3 3 
ton ER3** 
EDIT ER3 B 
EDITEKJo 
t ui TtR3 7 
PERMISSION REQEOITEkJo 
EDI T E*3 9 
EOITERi 3 
EUITtR^l 
EOI TEkh 2 
, EuiTEkLO 

E DIT EKH't 
EQITER*? 
EDI T ERho 
cDITERh.7 

“i V _ .. i 1 T T _ bi i* U 


FlNlSHuO/9H 


* ) 

CALL INCO (KARD , 5 J 

51 = 22 

52 = 22 
REWIND 51 
IU(1) - SI 

IU ( 2) = SI + 1 
IU ( 3 ) = FINAL 
CALL 1NTBUF(IU,1R) 

CALL OUTCO (ACTION, 51) 
DO 35 I = 1,1* 

35 AC T I ON ( I ) = BLANK 
ACTION(l) = END 
ACTI0N(2) = DECK 
CALL GU TC J ( ACT I ON » S 1) 
M'C CONTINUE 


EuITER* 9 
EDI 1 ER5 0 
c.01 T EK51 
eDIT tR52 
EDITEf<53 
EDI T tR»* 
cUITERBs 
tUlTERBo 
EUITER57 
cDIT ERa't) 
c.DiTtkS'* 
lOITERoJ 
EuiTERol 
tOIT tRB2 
EDI T ERE 3 
c D I T ER 6 



51 = S2 
REWIND Si 

52 = SI ♦ 1 

IF ($2 »GT • 23) $2 » 22 
REWIND S2 

Mooap = o 

NOOLP - 5300 

MUOUQ = 0 

MQOLQ = 5Q0Q 

CALL INCU (ACTION, SI) 

IF(ERFLAG.NE.G) RETURN 

CALL GUTCJ (ACTION, S2) 

CALL INCO (ACTION, Si) 

IF ( tRFLAG • Nc. . C ) RETURN 
IJ = 1 
GO TO 90 

50 CONTINUE 
IJ = 2 

IF (KARO (1) »EQ«6H00N£ ) GO TO 500 

IF(KARD(1) ♦EQ.6HLIST ) GO TO 55 

IF (KARO <i) *tO« EHiOtLET ) GO TO 61 

IF(KAR0(1) . £Q» 6H*CH ANG ) GO TO 62 

IF(KARO(l) . EG. 6HSINSER ) GO TO 63 

IF(KAROd) .EQ.6HSADJ ) GO TO 63 

IF(KAROd) .EQ.6HJALTER ) GO TO 62 

*♦8 CALL OU TGo ( KARO, S2) 

51 WRITE (PRTFIL, A9> 
call INCD(KARO,») 

GO TO 50 

55 CONTINUE 
IX = 1 

54 00 540 £- 1,5 
3 4 0 CNOu(I) = KARO (I) 

545 ENCODE (30, 56, SHOD) (CMOO( I ) , 1-1 , 3) 

56 FORMAT (5Ao) 

57 FORMAT (3(Ao,A4>> 


EOIT6R65 
EOITERoo 
tOITtR67 
tDIT£R6d 
EDIT Ek63 
EOITER7Q 
E0ITER71 
EDITER72 
EDITER73 
cDITer? 4 * 
EUITER75 
EDIT Ek7 6 
EOITER77 
EDIT £k7 6 
EDI T Ek 7 5 
EDIT ER60 
tOITEftbl 
EOITEK82 
ECITER63 
EOITER 84 
tOITtKflp 
EDITERdo 
EOITER87 
EU1TER66 
EDIT EK69 
COITER90 
EDIT Ek31 
cUiTtR^E 
cOaTEK93 
cDl T Ek 94 
EDI T EK9? 
cGiT tR9o 
EOITER97 
EDIT ER96 
EDIT c.R9^ 
EDiTEiOO 




JECOGt ( 3 J , 5? , tiMOO) CMQG 

tOITtiOi 


CALL VALUE ( CmOO < 3) , V, I£R> 

EDIT Eli) 2 


I F ( I E K • G T • Q ) GO TO 53 

ECITE103 


16 T = V 

tOITclO*, 


ISP = 1ST 

EOiTElQO 


IF(CrtGGd) «£Q.6HiALT£k ) GO TO 5300 

EDIT El 0u 


IF(CMOD(i) • EQ. 6r1$INSER > GO TO 5300 

EOITtli)7 


CALL VALUE (CMGD(5> , V, left) 

EOITE103 


IF(1ER,GT«3) GO TO 53 

EOITE139 


ISP .= V 

EOITE11G 


IF ( ISP« L T • I ST) ISP - 1ST 

EOITE11J. 

3 30 0 

CONTINUE 

cGITtUI 


GO TO ( 53,75,105) ,IX 

EDIT Eli 3 

5 3 

CALL LORO (FINAL, 1ST, ISP, PRTFIL) 

tOITtil^ 


PEW I NO FINAL 

cOIT£ll:> 


CALL iNTdUFdU, IR) 

EOITtllo 


GO TO 51 

c. OI i cl 17 

5 9 

FORMAT ( JoH ILLEGAL MJrttKlC ENTRY - RENTER CARu) 

EDIT El 16 

56 

WRITE (FERR, 59) 

c.01 TElli 


GO TO ( 51, 51, 1C o) ,IX 

E0IT£i2G 

ol 

IY = 2 

tOITclEl 


GO TO 6 *» 

EOl Tel 22 

6 2 

IY = 1 

E0ITE123 


GO TO 6 «, 

CUilElE-r 

63 

IY = 3 

cUlTti2:> 

oA 

IX = 2 

E0ITE126 


GO TO 5 v 

EDIT £127 

75 

INu - 1ST 

c OI Te12o 


INL - ISP 

cOITE129 

h 9 

FORMAT ( OH READY - ) 

E0ITE13S 


IF( INO.Gc.MOObP) GO TO 5G 

cOITE131 


IF ( INL. GT.H0D6P) GO TO 79 

c UI T El 32 

31 

CALL OUTGO (ACTION, S2) 

EOITE133 


IF < ACTION! 1) .EQ. END) GO TO hQ 

EOi.Tcl.3% 


CALL INCOJ ACTION, Sl> 

EOITE13:* 


GO TO 51 

cOI T El3o 



79 CONTINUE 

WRITE <FERR,82> 

62 FORMAKtOH MOD OVERLAPS EXISTING MOO - RENTER CARO) 
GO TO 51 
80 CONTINUE 

IF( INO.GE.MOCLP) GO TO 65 
IF< INl. GT. MOOLP) GO TO 79 
d3 MOO BP = INS 
MUOoQ = INl 
GO TO *»8 

90 CONTINUE 
IA = 0 

IF(ACTIONd) .EQ.bHiGELET ) GO TO 91 
IF( AO TIGNd) .EQ.bHiCHANG ) GO TO 92 
IF(ACTION(l) »£Q» 6 HSINS£K ) GO TO 93 
IF (ACTIONt ii .EQ.oHiAOO ) GO TO 93 
IF(ACTIGNd) .EQ.oHSALTER > GO TO 92 
GO TO 1 C b 

91 IA = 2 
GO TO 9>* 

92 IA - 1 
GO TO 9h 

93 I A = 3 
9h CONTINUE 

IX = 3 

JO 5b0 1=1 t 5 
po 0 CrlUDd) = ACTION (I) 

GO TO 5*+5 
195 MOOLP = 1ST 
MQOLQ = ISP 
106 GO TO ( 50 » 120 , IJ 
85 CONTINUt 

IF(IN0.cQ. MOOLP) GO TO 16C 
IF( ACTIONd) .EQ.ENO) GO TO 63 
67 CALL OUTCO ( ACTION, S2) 

CALL INCO (ACTION, SI) 


cUi T tl 37 
EDIT El 38 
EQITE139 
cOITcl-nj 
lOITlIhI 
cOITEt**2 
lDITEU 3 
EUITEltH 
tOI T El*t:> 
lOITlI^o 
c. OITEl* 7 
tOITElnd 
tOIT tin 9 
tOITtlio 
E0I1EI51 
EUITE152 
E0ITE153 
t-OITEli 1 * 
C.OIT E15? 
EoITE15o 
tOIT £157 
EOITE150 
C.OIT Ei?9 
c.01 T E16G 
tOITElol 
EDITE162 
tDITElb3 
EDIT Elo** 
EJITE165 
EDIT Eloo 
cOIT tl67 
EOITEI 08 
EJ1TE169 
E0ITE17G 
E01 TE171 
lOI Ttl72 



I 


IF (ERFLAG.NE.Q) RETURN 
IX = 3 

IF(ACTI0N<1) .NE.ENO) GO TO 90 
HUQLP = 50 00 
MOOLQ = 5000 
GO TO b 3 

120 IF( IA.tQ.0) GO TO 87 
GO TO 8C 

160 IF(IA*tQ*l) GO TO 170 

IFdA.EO .2) GO TO 130 

IF(lY.tO.l) GO TO 63 

IFdr.tQ.j) GO TO a3 

GO TO 200 

170 IFdY.tQ.l) GO TO 63 
GO TO 67 

160 IFCIY.cQ.l) GO TO 83 

IF( IY« cQ. 3) GO TO 87 

GO TO 200 

• 200 CONTINUE 

£ WRITt (Ft**, 210) 

’ 210 FORMAT ( h5H MOO CONFLICT^ WITH PRIOR MOO - PLEASE RENTER) 

GO TO 51 

500 CONTINUE 

510 CALL OUTCD (ACTION, S2) 

IF (ACTION(l) .EQ.END) GO TO 520 
CALL INCO (ACTION, SI) 

IF(ERFLAG.NE.O) RETURN 
GO TO 510 

520 CONTINUE 
Ml = 13 
REWIND Ml 
REWIND S2 
IU ( 1 ) = Ml 
IU ( 2) = S2 
CALL INTOUF (IU,IR) 

530 CALL INCO (KARD,S2) 


E0IIE173 
EDIT £17* 
EL1TE1 75 
EDIT tl7o 
tOIT tl77 
EDIT £1 73 
EOITE179 
EDI TE13G 
EDIT £131 
EGITE132 
EOITE183 
tGITElS* 
EDIT £135 
EUITE136 
EDIT E187 
tUITEiaa 
E0ITE139 
EOITE19G 
c01Ttl9i 
EDIT £192 
EDITE193 
EDIT £19** 
tOI T £199 
E0ITE19G 
EDI TE197 
E01TE196 
EDIT ti 99 
EDITE200 
EOITE201 
EDI I £202 
£OIT£203 
EDITE20*, 
EOIT £295 
tOITt206 
EOITE207 
£DIT£203 



IF < ERFL AG . NE • Q ) RETURN 
CALL OUTCU (KARO ,M1) 

IF(KARD(l) .NE.END) GO TO 5 4 3 

RETURN 

END 

FtlT,l OORMAN .TERM 

SUBROUTINE TERM 
C 

C TERMINATES THE RUN 

C 

C PROGRAMMER - S. WRAY 

C 

COMMON /MISC/tRFLAG,FcRR>KARO< 1 h) ,ACTION(l*t) 

INTEGER ERFL AG , F ERR , AC TION , PRTFIL 
EQUIVALENCE (PRTFIL ,FERR) 

IF(ERFLAG.Hc.O) WRITE (PRTFIL, 10> 

10 FORMAT ( 15H cRKOR IS FATAL) 

Y 1 WRITE (PRTFIL, 5) 

5 FORMAT ( 3 7H — END OORMAN — RUN TERMINATED — ) 

STOP 

END 

FELT,! DORMAN. A1TA6 

SUBROUTINE AlTAfc (CAton jCAl^) 

C 

' C ENTER WITH 6* WORDS EACH CONTAINING 1 CHARACTER 

C EXIT WITH In WOROS EACH CONTAINING 6 CHARACTER* 

C 

C PROGRAMMER: VOI T 

C 

DIMENSION CAIh ( l<t) ,CAo4(6h> 

ENCODE (6a, 5, CAIh) CASA 
5 FORMAT ( 1h(6A1) ) 

RETURN 

END 

FELT, I OORMAN. AoTAl 

SU3ROU1 INE ALTAI (CA1a,CA6a) 


tulT E209 
ED1TE210 
cOITtEll 
E0ITE212 
cbiTE213 
TERM 3 
TERM 5 
TERM o 
TtRM 7 
T ERM to 
TERM 9 
TERM 10 
Mj.SC 2 
MISC 3 
RISC *♦ 
TERM 12 
TERM 13 
TERM it 
TERM 15 
TcRM 20 
TERM 21 
A1TA6 3 
AlTAo 5 
A1TA6 6 
A lTAb 7 
AIT Ab to 
AIT Ac 9 
AIT Ab 10 
A IT Ab 11 
AIT Ab 12 
A IT Ab 13 
A IT Ab 1* 
A IT Ab 15 
A IT At lb 
AbTAl 3 
AoTAl 5 
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tNftfi WITH !<♦ WORUS cACH CONTAINING 6 CHARACTt RS 
EXIT WITH WGftuS EACH CONTAINING 1 CHARACTtR 

PKOGRAMMlKI voit 

01 (It Nil ON C41 l( 1*) ,CAd4<3*t) 

OcC 00c <8t,fa,CAl>+) CA8 h 
5 FORMA f( 1 *t ( oAl) ) 

RtTUKN 
END 

ELT,I JQRMAN . CUN V 

SUBROUTINE CONV 

converts decks 

PROGRA MMtk ~ S. WRAY 

COMhON /FILES/ aASIC,MTAPE , FINAL, SI ,S2 
INTEGER BASIC, MTAPt, FINAL, SI, S2 

COMMON /REST/TAbLE,USEi,FlLE,ENO,UECK,OGECK,BLANK , BATCH 
INTEGER TABLE, USES, FILE, E NO, DECK, DCECK, CLANK, BATCH 
COMMON /NAMES/ I Vt R , ON AM£ ( 2 > , MUuNAM C 2) , UNAMt < 2 ) 

INTEGER ONAME, MODNAM, 3NAME 

COMMON /MISC/ERFLA&,FERR,KARU(1h) ,ACTI0M14) 

INTEGER ERFLAG, FERR, ACTION , PRTFIL 
EQUIVALENCE ( PRTF IL , FE RR) 

DIMENSION IU ( 31 ,IR( 3) 

INTEGER VERS 
DATA VERS/faH VERSIO/ 

DATA IU,IR/0,G,0,2,2,2/ 

WRITt (PRTFIL, B) 

5 FORMAT ( 2 9H ENTEk NAME OF REFERENCE DECK/9H READY - ) 

CALL INCO ( KARD , 5 ) 

WRITE (PRTFIL, 1C) 

10 FQRMAT(25H t_NTt<\ NAMt OF FINAL JECK/9H hEAUY - ) 


AfaTAl a 
AfaTAl 7 
A6T A 1 fa 
AfaTAl 9 
AfaTAl 10 
AfaTAl 11 
AfaTAl 12 
AfaTAl 13 
AfaTAl 1*, 
AfaTAl is 
AfaTAl lo 
CON V 3 

C UN V > 

CON V o 
CONV 7 
CON V o 
CONV 9 
CONV 10 
FILES 2 
FlLtS 3 
REST 2 
REST 3 
NAMtS 2 
NAMtS 3 
MISC 2 
MISC 3 
MISC •» 
CONV 1 fa 
CONV io 
CONV 1.7 
CONV 1 o 
CONV 19 
CONV 20 
CONV 21 
CONV 22 
CONV 23 
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it) 

-o 
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CALL INCQ ( ACT ION 1 51 
IUC1) = 9 ASIC 
CALL IN T8UF ( IU , IR) 

ACT ION (3) = KARO(l) 

ACTIONS) = KARO (2) 

KK = 0 

KA = a 

REWIND BASIC 
REWIND 22 
REWIND 23 

ONE OR TWO OR NGNl USt PASSES 

15 CALL INCD (KARO , BAS 1C) 

IF(ERFLAG.NE.C) RETURN 
IF(KARQ(5) .EQ.VcRS) GO TO 15 
IF(KARO(l) .EQ.tND) GO TO AO 

IF< ( ACT I ON (1) .EQ.KAR0(2) ) . AND. (ACTION (2) . EQ . KARO ( 3) > ) KA=KARD ( A) 
IF( (ACT I ON (3) • E Q. KARO (2) > . AND. (ACTION! A) . cU .KARO ( 3 ) ) ) KK=KARO(A> 
GO TO 15 
AO CONTINUE 

FINAL = 23 

CALL USt ( ACTION(3) > 

FINAL = 22 
CALL USE (ACTION) 

60 CONTINUE 
RtWlNO 22 
RtWlND 23 
REWIND 13 

CALL OIFDEC (23,22,13,5) 

MOONAM (1) = ACTION (1) 

MOUNAM (2) = ACTION (2) 

RETURN 
E NO 

*ELT,i DORMAN. EXTRAN 

SUBROUTINE EXTRAN ( I T IH£ , I DA TE) 


CONV 

2a 

CON V 

2p 

CON V 

26 

CON V 

27 

CONV 

26 

CON V 

29 

CONV 

30 

CONV 

31 

CONV 

32 

CONV 

33 

CONV 

3a 

CONV 

35 

CONV 

36 

CONV 

37 

CONV 

36 

CONV 

3 9 

CONV 

+ 0 

CONV 

tl 

CONV 

hZ 

CONV 

*3 

GHT13 

2 

GWT13 

3 

CONV 

7-. 

GWT13 


CONV 

7 o 

CONV 

77 

CONV 

76 

CONV 

75 

CoNV 

60 

CONV 

ol 

CONV 

62 

CONV 

63 

CONV 

6*» 

CONV 

65 

EXTkAN i 

tXTRAN 5 
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c 

C ENTtRWITHo CH AN EACH IN I T 1 M , AND IOTc 

C EXIT WITH 2 WORDS (6 CHAR AND 2 CHAR) 

C 

C PROGRAMMER: VOIT 

C 

c 

DIMENSION ITIME (2) , IDAT£(2) 

DIMENSION I TMP < 3 ) 

DATA ISLS /1H// 

DATA INCL/1H./ 

CALL SKTRAN ( 9, IT1M , IDTE) 

OcCODc. <6,lOC»IT IM) ( I TMP < 1 ) , 1=1 , 3 ) 

100 FORMAT ( 3 A 2 > 

ENCODE (6,110, ITIMl) I TMP < 1 ) , INCL , 1 TMP < 2 ) , INCL 
110 FORMAT ( A2, Al, A2,Ai) 

IT I Mt (2 ) =1 TMP ( 3) 

DECOOE (6,100, IDTE) ( ITmP ( I ) , 1=1, 3) 

ENCCOE (o, 110, IuATE) ITMP( 1) , ISLS, I TMPC 2) , I SLi 
IDATE(2) = I T MP ( 3 ) 

RtTURN 

END 

* c L T ji I DORMAN .FIL3GF 

SU3RGUT INE FILBUF(oEGIN,£ND,MAX,OUF , F iLt ) 

CALLED 3 Y SUBROUTINES 

JIFUEC , RES I JR , ANO SYNC3F 


PROGRAMMER: \/GIT 

COMMON /MISC/ERFLAG 
COMMON /MISC/FERR 
INT EGER FERR 
iNTLGtR tRFLAG 

INTEGER BEGIN, END,M AX, 6UF( 1^,20) ,FIlE 


EXTRAN u 

EXTRAN 7 

EXTRAN 6 

EXTRAN 9 

cXTRANlu 

EXTRAN 11. 

t XTRAN12 

EXT RAN 13 

t XTRANi** 

EXTkAnI;* 

GHT25 3 

cXTRANl/' 

EXTRAnIB 

EXTRAN1G 

EXTRAN2IJ 

cXTRAN21 

EXTKAN22 

EXTRAN23 

EXTRAN2* 

t XTRAN2:i 

£XTRAn26 

£XT*An2/ 

FIlDUFi/3 

F IL3UF 

F 1L3UF l/o 

FiLdUFV? 

FlLbUFVd 

FIcdUF^) 

FILbOFlfi 

FlLouFli 

FIudUF12 

FIL3UF13 

FlLdUFl* 

FIl8UF1» 

FlLbUFlo 

FXLoUFl/ 
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i 

to 
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N = 8EGIN-1 

IF ( N . LT .MAX) GO TO 5 

WRITE (FERR, 1C) FILE 

10 FORMAT ( *9H FiLBUF - INVALID REQUEST TO FILL BUFFErt FOR UNIT, 13) 
ERFLAG = 1 
CALL TERM 
5 N = N 1 

CAlL INCD ( 3UF ( 1 » N) , FI Lc) 

IF (ERFLAG.NE.G) GO TO 16000 
IF (N.GE.MAX) GO TO 16 
IF (BUF( 1,N) .Nt.bHltND 0 ) GO TO 5 
15 END = N 
RETURN 

16 0 0 C CONTI NUc 

DO 16001 1=3, in 

16 00 1 BUF { I » N) = 1H 

BUF (l,N)=oHitN0 U 
BUF(2,N)=oHF FILE 
tND = N 
RE T URN 
END 

*ELT,I DORMAN . FNOBUF 

SUBROUTINE FND6UF (UNIT,X,Y> 

CHECK TO SEE UNIT Is ACTIVE 
RETURN MODE IN X 

PROGRAMMER - VGIT 

COMMON/ Ml SC/ ERFLAG, FERR 
INTEGtR ERFLAG,FERK 

COMMON / WGRK/I1GNT< 3) , IiRH ( 3) , IUT3L<3, 1 c j> , 1 ACT (6,3) ,NFIutS 
INTEGER UNIT , X , Y 
DO 10 1=1,3 
J = I 

IF (UNIT • EQ « IACT ( 1, I>) GO TO 12 


FIcBUFltt 
FILBUF IS) 
FIL6UF20 
FIL6UF21 
F1LBUF22 
F1U6UF23 
FiLbUF2*» 
FlLdUF2t> 
F lLoOF2o 
FILDUF2? 
FIL6UF26 
F ILBUF 2 9 
FIL6UF30 
FlLbUFJl 
FILBUF32 
FIL6UF33 
F 1LBUF34 
FILUUF35 
FIL6UF36 
FILOUF37 
FILBUF36 
FNOBUF 3 
FNOBUF 5 
FNOBUF 6 
FNOBUF 7 
FNOBUF 6 
FNOBUF B 
FNJBUF10 
FNOBUFli 
FNUoUF 12 
F NUoUFlB 
WORK 2 
FN0BUF15 
FNDBUFlo 
FNU6UF17 
FNOBUFid 
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10 continue: 

WRITE (F£RR,1CCG) UNIT 

1 00 G FORMAT { 28H FNOBUF - FATAL ERROR - UNIT,I3,11H NOT ACTIVE) 
ERFLAG = 1 
CALL TERM 
12 CONTINUE 
V = J 

X = IACT (2, J) 

RETURN 
t NO 

FElT>I DO RM AN , GE TGtN 

SUBROUTINE GET GEN (NAME , I FI LE , L 1ST , NL 1ST) 

GET GENEALuGY 

PROGRAMMER - B. GOLC 

DIMENSION NAME (2) ,L 1ST (2,20) 

COMMON /MI3C/ERFLAG,FERR,KAftO(l*> , ACTIOM1A) 

INTEGER ERFLAG,FERR, ACTION, PRTFIL 
EQUIVALENCE ( PRTFIL »FERR) 

COMMON /REST/TABLE,UScS»FlLE»END»0£CK» OOECK, BLANK ,8ATCH 
INTEGER TABLE, USES, FILE, END, OECK,OOECK, BLANK, BATCH 
OIMENSION IU(3> , IR( 3) 

DATA IU/2,2,2/,IU/Q ,0,0/ 

IU(1> = IFILE 
CALL INTBUFQU, IR) 

REWIND IFILE 
tRFLAG - 0 
LIST (1, i) = NAM c. ( 1 ) 

LIST ( 2, 1) = NAMt (2) 

NL 1ST = 1 

10 CALL INCO(KARO, IFILE) 

IF(ERFLAG.Nt.C) RETURN 
IF(KAROd) .NE.ENO ) GO TO 30 
IF(KARO(2) ,Nt. TABLE) GO TO 30 

WRITE (FERR,20) NAME, ((LIST(I,J), 1=1,2), J=1,NLIST) 


FNOBUF 19 
FNOBUF 2 0 
F nUBUF 2 1 
FNOBUF22 
FN0BUF23 
FNOMUF2*t 
FNOOUF25 
FNOBUF2© 
FN0BUF27 
FN0BUF28 
GETGEN 3 
GETGEN S 
GETGEN o 
GETGEN 7 
GETGEN d 
GtTGtN 9 
GETGEN10 
MISC 2 
MISC 3 
MISC *» 
REST 2 
REST 3 
GET GE Nl 3 
GETGEN1-. 
G t TG EN 1 3 
GcTGENiu 
G£TGtNl7 
GETGtNl 8 
GETGEN19 
GcTGEN20 
&c.TGtN2 1 
GETGEN22 
Gt.TG£N23 
GETGEN2* 
GtTGcNES 
GET G£N2© 
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*ELT 


FORMAT (36HQGtTGEN ERROR IN GENEALOGY FOR DECK ZA6/<4*.H GOULD NOT FIGETGEN27 


*NO LAST DECK IN FOLLOWING LIST-// (&X2AE) ) 
ERFLAG = 1 
RcTURN 

IF (KARO ( 2) .NE.LIST ( 1 , NLIS T) ) GO TO 10 
IF (KARO(3) .NE.LIST (2, NLIST) ) GO TO 10 
IF(KARDU) .EQ. BLANK) RETURN 
NL 1ST = NLIST+1 
LiSTtl, NLIST) = KARU<5) 

LIST (2, NLIST) = KARD(b) 

GO TO 10 


GETGENZd 
GETGEN29 
GETGEN30 
GETGEN31 
GET GEN 32 
GeTGeN33 
&ETGEN3** 
G £T G EN3B 
GET GeN3o 
GETGEN37 


END 

I DORMAN. INCRT 
SUBROUTINE INC RT 

CRtATtS A DATA GASE 

PRO&RAMMtk - 3. WRAY 

DIMENSION I J ( 3 ) ,IR( 3> 

COMMON /FILES/ BASI C » M T APE , FI NAL , SI » S2 
INTEGER BASIC, MTAPE , FINAL, 31, S2 

COMMON /REST/T ABLE, USES, FILE, END, DECK, CHECK, BLANK , BATCH 
INTEGER TABLE, USES, FILe,ENO, OECK,UDECK, BLANK, BATCH 
COMMON /MISC/c.RFLAG,FcRR,KARO(1*) ,ACTI0N(1D 
INTEGER ERFL AG , FERR , AC T ION , PRT FI L 
EQUIVALENCE (PRTFIL »FERR> 

COMMON / VCARD/ILBL ( l*+> 

DATA IR/2,2,2/ 

IU(1) = & 

IU ( 2) = BASIC 
XU ( 31 - 0 

CALL InT 3UF ( IU , IR) 

REWIND BASIC 

CALL EKTRAN (ILBL (12) , ILBL ( 10) ) 

CALL OUTCO (ILBL, BASIC) 


Gt.T&cN3a 

INCRT 

3 

INCRT 

3 

INCRT 

o 

INCRT 

y 

INCRT 

a 

1 NCRT 

a 

iNCRT 

10 

INCRT 

li 

FILlS 

2 

FILES 

3 

REST 

2 

REST 

3 

MlSC 

2 

MISG 

3 

MISC 

4 

INCRT 

13 

INCRT 

lo 

INCRT 

17 

INCRT 

18 

x NCRT 

13 

INCrT 

20 

INCRT 

21 

INCRT 

22 

INCRT 

23 





JO S I = 1,1* 

ACTIQN(I) = BLANK 
5 KARO(I) = BLANK 
KARO ( 1 ) = £NC 
KARL C 2) = TABLE 

KARL) ( 3) = lHc 

ACT ION ( 1 ) = OOECK 
ACTI0N(2) = bHTESTOH 
ACTION(L) = USES 
ACT ION( 5) = sH TEST 
CALL OUTCD ( ACT ION , 3 AS IC) 
ACTIONS) = BLANK 
ACT i ON( 5 ) - BLANK 
ACT I ON( 2 ) = 5H TcST 
CALL OuTCJ (ACTION, BASIC) 
CALL OUTCJ (KARO, BASIC) 

ACT ION( 2) = 6HTEST0R 
ACTION(L) = USES 
■ AC T ION ( 5 ) - &H TEST 

& CALL OUTCO( ACTION, BASIC) 

1 KARO ( 2) = DcCK 

KARO (3) = 3L ANK 
CALL OUTCJ (KARO, BASIC) 

AC T ION (2) = 5H TEST 

ACTION!**) = BLANK 

ACT ION ( s) = BLANK 

CALL OUTCD (ACTION, BASIC) 

CALL OUTCD (KARO, BASIC) 

KArO(2) = FILE 

CALL OUTCJ (KARO, BASIC) 

REWIND 21 

CALL AODX ( 21 ) 

RETURN 

END 

FELT i> I DORMAN. INCD 

SUBROUTINE INCD (ICRD, IUNIT) 


INCRT 2** 
INCRT 2s 
INCRT 2b 
INCRT 2/ 
INCRT 26 
INCRT 2B 
INCRT 30 
INCRT 31 
INCRT 32 
INCRT 33 
INCRT 3*+ 
INCRT 3s 
INCRT 3o 
INCRT 37 
INCRT 3d 
INCRT 3D 
INCRT ‘♦0 
INCkT tl 
INCRT **2 
INCRT **3 
INCRT 
INCRT As 
INCRT *,b 
INCRT *7 
INCRT **6 
INCRT 
INCRT sd 
INCnT si 
INCRT s2 
INCRT s3 
INCRT s*. 
INCkT 3s 
INCRT so 
INCRT s7 
INCOM $ 
INCJM 3 
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PUT IN FORCE OF t ASG 

HODc 1 - READ 55 CARDS 

MODE 2 - READ 1 CARO 

MODE 3 - READ 1 CARO, MAY BE PACKEO 

PROGRAMMER: VQIT 

INTEGER ICR0(l«O 

COMMON /RtST/TABLc, USc.S, FILE, END, DECK, OOECK , BLANK , BATCH 
INTEGER TABLE,USES, FILE, END, 0ECK,0DECK, BLANK, BATCH 
COMMON ✓ WORK/ HUNT (3>, IIRH(3>, IUTdL(3,19) , 1 ACT (6,3) ,NF1L£S 
COMMON /BFRS/ XXXC5 h) 

COMMON /BFRS/ IM 00 1(14, 55,2) , INK 1(168, 2) , IT EMP1 ( fa<*) , ITEMP2 ( 64) 
COMMON /MISC/ERFLAG,FERR,KAR0(1*> ,ACTIGN(1*> 

INTEGER ER FLAG, FERR, ACTION, PRT FI L 
EQUlVALtNCc (PRTFIL ,Fc RR) 

DIMENSION ITMPl(l) , ITMP2U) 

EQUIVALENCE (ITMPl(l), I TEMPI ( 1 ) ) , ( I T EMP2 ( 1) ,ITMP2(D) 

IF( IUN1T ♦ EQ. 5) GO Tu 5 
CALL FNQ8UF ( IUNIT , IX, IY) 

IF (IX.NE.2) GO TO IOC 

MODE lQ 2 — Rt AO ONt CARO 

IF (IACT (•♦, IY) »EQ.l) GO TO 510 
CALL UREAO (IUNIT, ICRO) 

IF END OF FILE, SET FLAG 

20 CONTINUE 

IFdCRO(l) .Nt.tND) RcTURN 
IF(1CR0 (2) .NE.FlLc) RETURN 
IACT (4, IY) = 1 
IF( IUNIT. tQ.5> CALL TtRM 


INCOH 

fa 

INCDM 

7 

INC DM 

fa 

INCUM 

9 

INCDM 

10 

INCDM 

11 

INCDM 

12 

INCDM 

13 

INCDM 

1** 

INCDM 

1 ? 

REST 

2 

REST 

3 

WORK 

2 

BFRS 

2 

BFRS 

3 

MI3C 

2 

M1SC 

3 

MISC 


INCDM 

20 

INCDM 

21 

INCDM 

22 

INCDM 

23 

INCUM 

2* 

ihCDM 

Zo 

INCDM 

Zb 

INCDM 

27 

INCDM 

26 

INCDM 

2d 

INCDM 

30 

INCDM 

31 

InCDM 

32 

INCDM 

33 

INCUM 

3t 

INCOM 

3b 

INCDM 

3o 

INCDM 

37 
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RETURN 

10 3 CO NT I NUc 

IF <IX,Nc.l) GO TO 2 GO 

MODE 1 

IS BUFFER EMPTY 

XXX = IACT ( d , I Y ) 

IYY = IACT <7, I Y> 

IF UACT (4, IY> .eQ.l) GO TO 510 
GO TO 135 

CAN WORK AREA TAKE dH CHARACTERS 

117 CONTINUE 

IF (IXX.GT.d*,) GO TC 170 
If (IACT(h,IY) • £Q« 1 ) GO TO 170 

PUT d, CHAR FROM BUFFt R INTO TOP OF WORK AReA 

CALL A6 T A1 ( IMQO 1 ( 1 » IYY , IY) , IWKl ( IXX+1 , 1Y ) > 

IXX = IXX 4- 
IYY = IYY + 1 
iF<IYY.N£.5b) GO TO 117 

REAO IN NEXT BUFFER FULL 

153 CONTINUE 

00 160 1 = 1,53 

Re A U (IUNIT ,156, END = 510 »£RR=51G) ( I MOO 1 ( J , 1 , 1 Y) , J= 1 , 77 Ii ) 

153 FORMAT ( 773 Ab) 
lo0 CONTINUc 
IYY = 1 

IACT ( •,, IY) = G 
GO TO 117 


INCOM 3d 
INCUM 3j 
InCom hu 
INCUM 4 1 
INCOM *»2 
INCUM *3 
INCuM 44 
INCOM *5 
INCiiM to 

iNCOM 4/ 
INCUM 4 li 
INCUM Hi 
INCUM 5! 3 
INCUM *1 
INCUM id 
INCOM a >3 
INCOM it 
INCOM 55 
INGUM ao 
INCUM 57 
INCOM 5d 
INCUM 5 5 
INCUM oO 
INCuM ol 
INCUM 62 
INCOM 63 
InCuM O', 
INCOM o\7 
INCOM bo 
INCOM 71 
INCOM 72 
IWCuM 7t 
INCOM lo 
INCuM 7u 
INCOM 77 
INCUM 7o 
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c 

c 


MOVE CAROi FROM WORK AREA INTO CARO 


> 


170 CONTINUE 

CALL UNPAC (ITEHPl, XTEMP2, ICH) 

CALL AlTAo(I7EMP2,ICRu) 

MOVE uOHN WORK ARlA 

K = XXX-1CH 
IF(K.cQ.O) GO Tu 195 
00 190 1=1, K 
ICH 1 = i+lCH 

IwKKI, Ilf) = IWKKICH1 ,IY) 

190 CONTINUE 
195 CONTINUt 
IXX = K 

I ACT t a, I Y) = I XX 
IACT (7, XY) = 1 YY 
GO TO 20 
200 CONJINUc 

I F ( IX #N£ * 3 ) GO TO 500 

MOue 3 

5 CONTINUE 

CALL UREAO <aUNIT,ICRD) 

CALL AoT A1 (XCkOjITcMPI) 

CALL UNPAC < 1TE.MP1, ITcMP2, ICH) 

CALL AlTAo( ITEMP2 ,ICRG) 

IF(OAlCH.tQ.IUMT) CALL OU TCO ( ICRO , PRTF XL) 
GO TO 20 

ERROR EXIT 

500 CONTINUE 

WRITE (FERR, 1000) IUNXT,IX 


A NC U H 79 
X NCLiM a 0 
INCUR Oi 
INCUR 02 
1NCUM 66 
INCUR «*+ 
XNCuh d5 
aNCOM do 
INC OH 67 
XNCUH do 
INCUR 39 
XNCUH 90 
XNCOM 91 
InCOR 92 
INCuH 93 
INCUM 9*. 
1NCUM 95 
INCUM 9o 
INCUR 97 
Incur 90 
INCDR 99 
INCUR10G 
INCURiai 
INCUR1 0 2 
lNCOHld 3 
iNCOMltK 
INCUM105 
INCURlOo 
1NCOM1J7 
INCUMIUd 
INCUR109 
1NCUH110 
INCUH111 
INCUR 112 
ANCUM113 
INCUR!!* 



100;} 

FORMAT (26H INCU - MODE ERROR — UNIT, 13, 5H M0uE,I3> 

INCuMUe 


ERFLAG = 1 

iNCOMilc 


CALL TERM 

INCUMil? 

510 

CONTINUE 

iNCOhllE 


WRITE (FERR,2GG0) IUNIT 

INCOMA 1 C J 

2000 

FORMAT ( 2 7H INCO - tNi) OF FILE ON UNIT ,13) 

INCUM120 


ERFLAG = 1 

INCOM121. 


IF< IUNII .EQ.5) CALL TERM 

I NG0M122 


RETURN 

INC0M123 


END 

INC0M12V 

*2 LT ;i 

i dorman * insert 

INSERT 3 


SUBROUTINE INSeRT (NSTP ,11) 

INSERT 5 

C 


INSERT 6 

C 

INSERT 

INSERT 7 

C 


INSERT 8 


COMMON /aFRS/ I SYN ( 2,201 , I SYN1 , IT1 , IT2 , I T3 , FULL , CN1 , CN2 , LI Nl » LIN2 

6FRS1 2 


* , NWBUF ,NB1,NB2, ICN 1,1 CN2 

BFRS1 3 


COMMON /dFRa/ BUF1(1«*,50) , 3UF2 ( 1 4, 5 G ) , A AA (7 0 0 ) 

BFRS1 h 


INTEGER C N 1 , CN 2 , 6 UF 1 , d UF2 

UFRS1 :> 


LOGICAL FULL 

BF RSI 6 


INTEGER FI Nl, FIN 2 

I NSERT 10 


EQUIVALENCE <FOUT,IT3) 

INSERT 11 


EQUIVALENCE <FIN2,IT2) 

I NSeRT12 


EQUIVALENCE (FIN1,IT1) 

INSeRT 13 


INTEGER FOUT 

ANSERT1*, 


IF(II.Nt.C) GO TO 10 

I NSeRT A :> 


J = LIN1 - 2 

INSERTlto 


WRI Tc (F OUT ,h6) J 

lNStRTl/ 

HD 

FORMAT ( 7 Hi INSERT ,113) 

I NSERT 18 

10 

CONTINUE 

INSERT 1 j 

50 

CONTINUE 

A NSERT 2 0 


LSTCO = (NB2-CN2) + LIN2 

INSERT21 


IF (NSTP.GT.LSTCU) GO TO 100 

I NSeRT 22 


KK = NSTP-LIN2+CN2-1 

INSeRT 2 3 


WRITE (FOUT, 9) C(BUF2(I,K) ,1 = 1, In) , K=CN2 , KK ) 

INSERTED 


KK = KK - CN2 ♦ 1 

I NSERT 25 



o o oooono 


LIN2 = LIN2 ♦ KK 
CN2 = CN2 ♦ KK 
RETURN 

103 CONTlNUc 

KK = NB2 - GN2 + 1 

WRITE (F0UT,9) ( (OUF2(I,K» ,1=1,1*) ,K=CN2,Nb2> 

L IN2 = LIN2 + KK 

CALL FlLBUF { 1 , NB2 , is Wu UF , 0 UF2 , FIN2) 

CM2 = i 
GO TO 5 0 

9 FORMAT <l*Ab) 

END 

*cLT,I DORMAN. INTBUF 

SUBRQUT INE INTBUF (IUNT,IRW) 

ENTER WITH 3 UNITS AND READ/WkITE STATUS 

Initialize active table 
programmer: VQIT 

COMMON /MI SC/ ERF LAG , FE RR, K ARD < 1*> , ACT ION (1 A) 
iNTEGeR ERFLAG , F ERR , ACT ION , PRT F I L 
EQUIVALENCE (PkTFIL ,FERR> 

COMMON /WORK/ HUNT (3>,IIKW(3),IUTflL(3,19),IACT(8,3),NfiLES 
COMMON / DFRS/ XXX<5*) 

COMMON /OFRS/ IMOU1 ( 1*, 55, 2> ,IWK1(168,2) , IT EMP1 ( 8*) ,ITtMP2(8*) 
DIMENSION IUNT (3) ,IRW< 31 

IUTDL UNIT TABLE 

C 1 - UNIT NUMBER 

C 2 - MODE 

C 

C I ACT — - 3 ACTIVE FILES 

C 1 - UNIT NUMBER 

C 2 - MODE 

C 3 - 0=READ ONLY, 1=WRITE ONLY, 2=KtAD OR WRITE 


INSERT 2o 
Insert zi 
INSERI29 
INSckT 3 3 
INScRT31 
INSERT 32 ; 
INSERT 33 
INSERTS* 
I NSERT 3 p 
lNSERT3t> 
I NSERT 3 1 
INSckTSd 
INTBUF 3 
INTBUF 5 
INTBUF 6 
INTBUF 7 
INTBUF o 
INTBUF 9 
INTBUF 1C 
INTBUF 11 
RISC 2 
M ISC 3 
MISC * 
WORK 2 
dFRS 2 
t>FRS 3 
INTBUF15 
INTBUFlo 
INTBUF 1/ 
INTBUF 18 
I NTBUF 19 
INTBUF20 
INTBUF21 
INTBUF 22 
INT6UF23, 
1 NT BUF2* 




c 


INTBUF25 


c 

3 - RtAL=0 , WRITE=1 

INTBUF26 


c 

h - FILE STATUS 1 = END UF FILE, 2= Rc WIMO, 0= IN USE 

INTdUF27 


c 

B - 3UFFtR INDEX 

INTaUf 2 6 


c 

6 - WORK AREA INQEX 

INTBUF29 


c 

7 - BUFFER CARD COUNTER 

INTBUF 30 


c 

a - WORK AREA CHARACTER COUNTER 

INTBUF31 


c 


1NT BUF 32 



DIMENSION I MOD 2 ( 1 7S 0) 

iNT BUF 33 



EDUlVALtNCS <IMDU2( 1) , I MODI (1, 1,1) ) 

INTBUF 3^ 



KK = NFlLcS 

INTBUF3:. 



UO1C0 L = l,3 

I NT uUF 3o 



UO 10 1=1, KK 

I NT BUF 37 



J = I 

INTBUF36 



IF( IUNi (LI . EQ.O) GO TO 11 

I NT BUF 3 9 



IF (IUNTCU .tQ. 1UTBLC1 ,D) GO TO 12 

I NT dUFtii 


10 

CU NT INUE 

INTdUF^l 



GO TO 260 

iNTBUF^Z 

1 

11 

DO 9 K = 1,6 

INTBUFhJ 

CO 

9 

IACT(K,L) = C 

INTdUF 



GO TO 100 

INTBUF'+a 


c 


I NTaUF>*o 


c 

UNIT FOUND 

InTBUF*/ 


c 


INTBUF 


12 

CONTINUE 

INTBUF*, B 



IACT ( 1, L) = 1UNT(L) 

INTBUF d u 



IACT (2, L) = IUTBL (2 , J) 

I NT BUF B1 



I ACT ( 3, L) = IRWIU 

INTBUFB2 



K = I ACT ( 1 , L ) 

1NTBUFB3 



IACT ( *♦, L ) = 2 

I NT BUF a*. 


100 

CONTINUE 

1 nTBUFB :» 


c 


I NT BUF Bo 


c 

ASSIGN OUFFcR FOR MODE 1 

INTBUFB7 


c 


I NT BUF 5 tt 



K = 0 

INTdUFBB 



UO 20 0 L= 1 , 3 

INTBUFoO 



ODD O O O 


IF (IACT(2,L) .N£.l> GO TO 150 
K = K+l 

IF (K.GT.2) GO TO 250 
JO 5 1=1,1780 
IH0D2 ( 1 ) = 3 
5 CONTI NUc. 

I ACT (5, L) = K 
IACT (6, L> = K 
GO TO 160 

150 IACT (5,L) = C 

FORCE REFERENCE TO ♦ASG 

I ACT { 6, L) = C 
IACT ( 7, L) = 6 
IACT ( 8, L) = 0 
GO TO 200 
160 CONTINUE 

IACT(7,L) = 1 
IACT (8,L) = 0 
200 CONTINUE 
RETURN 

ERROR EXIT 

260 CONTINUE 

WRITc. ( FcRR, 1C 0 0 ) IUNT(L) 

100 0 FOKMATCIaH INT6UF - UNIT,I3,2hH NOT FOUNU IN UNIT TABLE* 
1001 ERFLAG = 1 
CALL TERM 
250 CONTINUE 

WRITE <F£RR,1C10) IUNT (L) , ( IACT ( J ,L) , J=1 , 8) 

1010 FORMAT ( 29H INTGUF - CANNOT ASSIGN UNITS , I 3/ 5X , 8 1 10) 

GO TO 1001 
END 

XELT , I OORMAN .LA3LEK 


INT dUFol 
INTBUFb2 
INTBUF63 
INTBUFo*, 
iNTBUFb? 
INT BUFoo 
!NT bUFo7 
INTBUFod 
I NT BUFo 9 
INTBUF70 
INT6UF71 
INTdUF72 
INTUUF73 
INT 6UF7«» 
1 NToUF 75 
IwTbUF 7o 
iNTdUF 77 
INTBUF76 
int buf 7 9 
iNTaUFdfl 
INT BUF31 
1 NT BUFB2 
INT BUFB3 
INT BUF 8* 
I NT dUF 85 
XNTBUFdb 
I NT BUF 87 
INT6UF66 
INTBUF89 
InT BUF90 
INTbUF'Bi 
INTBUF92 
1NTBUF93 
I NT BUF 9 h 
INT BUF 9a 
LABLck 3 
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SUBROUTINE LABLER ( IV£R,FILE1,FIL£2) 

WKlTt LABEL AND VERSION ON FI LEE 
THc. N COPY FILE1 TQ FILE2 

PkOGR AMMER : VOI T 

COMMON /MISC/ERFlAG , FERR 
INTEGER ERFLAG , Ft RR 
DIMENSION IFL( 3) , IRR(3> 

DIMENSION ICRDd*) 

COMMON /VCARU/Il3l( 1*+) 

INTEGER FILE1,FILE2 

FILL IN Vc. PSION NUMBER, JATt ANO TIMc IN ILBL 
iLuL ( 7i - IVEk 

CALL EXTRAN dLBL ( B) ,1 L8L dl> ) 

INITIALIZE FILES AND TRANSFER DATA 

IFLdi = FILtl 
IFL<2> = F I Lc2 
IFL ( 3) = 0 
IRN(I) = 0 
I RW(2) = 1 

CALL INFdUF (IFL, IRK) 

CALL OUTCO 1 1 LB l , FI LE2 ) 

CALL INC J dCRLi, FILED 
IF(tRFLAG.Nt.O) GO TO 50 
3(1 CONTINUE 

CAi_L INCO ( ICRD , FILED 
IF ( ERFL A6« Nc • C > GO TO 50 
CAlL OUTCO (ICR0,FILc2) 

IFCICRO (1) .NE.6HSENU 0 ) GO TO 30 
IF ( ICRD < 2) *N£«6rtF FlLc ) GO TO 30 


L ABLER 5 
L ABL ck o 
LABlER 7 
L ABLER <S 
LA3LER -i 
L ABL ERIC 
L ABLERli 
LABLER12 
LABLER13 
L A3LER1* 
LAdLEklB 
LABLERlo 
LAdLEKl? 
L ASLeRIB 
LABlEkIB 
LASLER20 
LABLC.R21 
L A8LcR22 
L A5 LEk 23 
LABLER2v 
L ABL ER2;> 
L ABLtK2o 
L ABL tin. 2 7 
l ABuER2<J 
LABLER29 
u ABLER Jo 
L ABttRJl 
L ABlER 32 
LAdLtR33 
LAdLtRiif 
L ABL ER3b 
L ABL ER36 
LABLcR37 
LABLEk33 
L ABLEr33 
L ABLER'tU 



o o o o o 


SAYEU ) 


RE T URN 

50 WRITE (F£RR,3l) 

51 FGRMATt^lH LAtstL • NEW UAT A FILE COULD NOT bt 
ERFLAG = 1 

RETURN 

END 

*cLT,I DUKHAN .LORD 

SUBROUTINE LCRD tFlLE,I3TRT, 1ST P, PRTFIL) 

LIST CARDS UN PRTFIL 
P ROGSAHMER * VOIT 


i 

tn 


i 


6 

5 


10 



27 

2 d 


INTEGER PRTFIL, FILE, CARO(Ih) 

IF ( P RTF I L • Nc< b > WRITE (PRTFIL,6) 
FORMAT ( 1H1) 

WRITt (PRTFIL, 5) 

FORMAT ( 1H 3 J 

IF( IST^T.LT .C) ISTRT=0 
IF (ISTP.lT.ISTkT) GO TO 50 
CUNT I NUE 

IF(ISTKT.EQ.O) GO TO 25 

DO 20 I=1,ISTRT 

CALL INCO (CARD, FiLc) 

IF (CAkO ( 1) . NE.6HSENG 0 ) GO TO 20 
IF (CARD (2) •c.Q.bHF FILE > GO TO 100 
CONTlNUt 
CONTINUE' 


OO 30 I=ISTRT , ISTP 
CALL INC0(CARD,FILE) 

00 27 L- 1 , 1*» 

J - 1 5 _ L 

IF(CARu(J) .NE.1H ) GO TU 28 

CUNTINUE 

CONTI NUc 

WRITE (PRTFIL, 2o) I, (CARD(LL) , LL=1,J) 


L AdLEKtl 

LAtiLtK^E 

L ABLER-,3 

L AdLERtM 

LAuLcR*+6 

LABLcR+6 

LORD 

3 

LCkO 

5 

L CRU 

o 

LCRU 

7 

LCRu 

8 

LCRD 

5 

LORD 

10 

LCRu 

11 

LuRU 

12 

LCRu 

13 

LCRU 

1*, 

LCRU 

15 

LCRU 

lo 

LCRu 

17 

LCRU 

18 

LORD 

19 

LCRU 

2d 

LORD 

21 

LCRU 

22 

LCRD 

23 

LCRU 

2** 

LCRD 

25 

LCRU 

26 

LCRD 

27 

LCRD 

28 

LCRu 

2 'i 

LCRU 

id 

LCRU 

31 

LCRD 

32 

LCRu 

33 
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26 FORMAT( I5,1X,1hA6) 

IF (CARD < 1) .NE.CHiENG G ) GO TO 24 
IF(CARU<2> .EQ.bHF FILE ) GO TO 100 
2»» CONTI NUt 
3 0 CONTI NUt 

WRITE ( PRT FIL , 5 ) 

RETURN 

90 15 TP = 1STRT 

GO TO 10 
100 CONTINUE 

IFCPRTFIL.NE.6) RETURN 
WRITt (PRTFIL, 1000) I 

1 00 0 FORMA T ( 45H LCRO - COUNT TOO HIGH, FOUND END OF FltE AT , 
WRITE (PRTFIL, 9) 

RtTURN 

END 

Ft LT , I DORMAN .LISTER 

SUBROUTINE LISTER 

LIST OPTIONS SUBROUTINE 

PROGRAMMER - S. WRAY 

DIMENSION I U ( 3 ) ,IR( 3) 

COMMON /NAMES/ I VER, QNAMt t 2) , MOUNAK ( 2) , BN AME ( 2 ) 

INTEGER ONAME, MODNAM, 3NAME 

COMMON /FILtS/ uASI C , M TAPc , FINAL , SI ,S2 
INTEGER BASIC, MTAPE, FINAL, SI, S2 
COMMON /MISC/ERFLAG ,F£RR,KAR0(l4) ,ACTION(l4) 

INTEGER ERFLAG,FERK,ACTION,PRTFIL 
t QU I VALENCE CPRTFIL ,Ft RR) 

WRITE ( PRTFIL, 66) 

66 FORMAT (63H ENTER LIST OPTION (CONTENTS, GENEALOGY, COUNT 
* PRINT) /9H READY - ) 

CALL INCO (KARD,5> 

IF(KAROtl) .EQ.6HC0NTEN ) GO TO 69 


LCRO 

3h 

LCRO 

3s 

LCRO 

3o 

LCRO 

37 

LORD 

38 

LCRO 

39 

LORD 

hH 

LCRu 

41 

LCRO 

42 

LCRO 

43 

LCRO 


LCRO 

•*5 

LCRO 

46 

LORD 

*♦7 

LCRO 

•*8 

LCRD 

*♦9 

LISTER 3 

LISTER » 

LISTER o 

LlSTtR 7 

LISTER B 

LISTER 9 

L 1ST cRli) 

LISTER1L 

NAMES 

2 

NAMES 

3 

FILtS 

2 

PILES 

3 

MISC 

2 

M1SC 

3 

MISC 

«* 

L1STER19 


, CARDS ORLIST EKlo 
LIST ER17 
LISTEkIS 
LIST £R1 9 



I 

Ul 

u> 


If (KARU(l) .EQ.bHGENEAL ) GO TO 67 
IF (KARO l 1) ,cQ. 6HC0UNT ) GO TO 70 
IF(KARUd) .EQ.6HCARCS ) GO TO 80 
IF(KAROd) .cQ»6HPRInT ) GO TO 90 
RETURN 

67 WRITE <PRTFiL,66) 

63 FORMAT (2 79 ENTER NAME OF DECK DESIREO/9H READY - i 
CALL ING0( ACTION,?) 

CALL LISTGt ACTION, BASIC) 

RETURN 

69 CALL LISTTC(oASIC) 

100 Rc. TURN 

70 CONTINUE 
IX = 1 
GO TO 75 

30 CONTINUE 
IX = 2 
GO TO 75 
90 CONTINUE 
IX = 3 
75 CONTINUE 

71 FORMA T ( 1 9H ENTER NAME OF DECK/ 13H OR FILE NUMBER/ 2 *»H OR 
♦ENT FILt NAMt/liH OR 0GNE/9H READY - ) 

WRITE (PRTFIL,71) 

CALL INCU (KARD, 5) 

IF(KAR0<1> .tQ.4HOONE) RcTURN 
ITAPc-0 

CALL VALUE (KARO, V, IERR) 

IF( 1ERR.EO. 0) ITAPE = V 

IF(KAROd) .cQ.oHBASIC ) ITAPt = BASIC 

iF(KARDd) .EQ.bHFINAL ) ITAPE = FINAL 

IF C ( KAkD ( 1) .EQ.BNAME(i)).AND. (KAR0(2).EQ«BNAME(2))) ITAPE = 
FINAL = 1 h 

IF< IT Apt « tQ. 0) CALL USt (KARD) 

IF(ERFLAG.nE.O) return 
IF( ITAP c.EO.C) ITAPE=FINAL 


LIST ER20 
L1STER21 
LISTEK22 
LIST ER23 
L IiT tR2** 
L 1ST E(v2 5 
LIST EK2o 
LIST Ek2 7 
LISTER23 
LIST tR2 9 
LlSTtKSL 
LISTER31 
LIST ER32 
LI*T ER33 
LIST tR3* 
LIST ER35 
L IsT Ei\3o 
L1STLR37 
L IST tR36 
LISTEK39 
LISTUOtO 
CURRLioTERd 
L I S T ER*»2 
LIST ERh 3 
LISTER** 
L I S T t K* 5 
LIST Ek*o 
LISTlR*7 
LISTER*6 
LIST £k* 9 
LIST ER50 
FINAL LlsTcR?i 
LIST c.R52 
LIST ER53 
LIST ER5* 
LIST ER55 



I U C 1) = 5 
I J ( 2) = ITAPE 
IU(3> = 3 
XR < 1 • = 2 
IR < 2> = 2 
IR { 3) = 2 
RENINO ITAPE 
CALL IN TdUF ( IU, IR) 

IFdX.cU.l) GO TO do 
IF ( IX #EQ. 3) GO TO 95 
d 1 WRITE (PRTFIL,d2) 

6Z FO RM AT ( 2 7H ENT Ek NUMBEk OF FIRST CAR0/9H READY - ) 
CALL INCH (KARO, 5) 

CALL VALUE ( KARO , V, IERR) 

IF (IcRR.NE.O) GO TO dl 
1ST ART = V 

03 WRITE ( PRTFIL, b*) 

d* FORMA T ( 2 7H ENT £* NUMBER OF LAST CARO /9H READY - ) 
CALL INC D (KARO, 5) 

ISTOP = 0 

IF ( KARO ( U .EQ. IH ) ISTOP = ISTART 
IF(ISTOP.NE.C) GO TO ftp 
CALL VALUE (KARO, V, IERR) 

IF(ItRR.NE.C) GO TO 63 
ISTOP = V 

65 COnTInUc 

CALL LORD ( I TAPE , IS TAR T , IS TOP , 61 
GO TO SO 

66 CALL COUNT ( ITAPE) 

GO TO 70 

95 CONTINUE 

CALL LCRO(IT APE, 0,50000, 20) 

GO TO 90 
EN J 

#cLT , I OOkMAN. LisTG 

SUBROUTINE LISTG(NAME, IFILE) 


LIsT ERpo 
L 1ST tR57 
LIST LRp 6 
LISTER59 
L 1ST tKoO 
L IsTc.R61 
L 1ST ER62 
LIST tkbd 
L 1ST ERb*v 
LIST EkbS 
L I$TER6t> 
LIST ERb7 
L I S T E R6 6 
c 1ST ERb'i 
L X S T Ek 7 0 
LlSTER/1 
LISTcK72 
LI,>TtR7 3 
LISIER7-, 
L IsT tR7:> 
L ISTtR7 b 
LISTER77 
L ISTEk7d 
L 1ST ER79 
LISItRdQ 
L ISTER6 1 
LIST tkd2 
LIST ERS3 
LlSTEkd*, 
L IsTERSp 
<-IST tRSb 
LISTERS/ 
L ISTEkdb 
L isTERdy 
LISTG 3 
LISTG » 
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LIST GENEALOGY 

PROGRAMMES - 6. GOLD 

DIMENSION LIST (2* 20) > NAM£(2> 

COMMON /MISC/ERFLAG,FERR,KARO( 1h) , ACT ION < 1 4) 

INTEGER £RFlAG,F£RR,ACTION,PRTFIL 
EQUIVAL t NCc (PRTFIL »Fc.RR) 

CALL GETGENtNAME, IFILE , LIS T, NLIST) 

IF (ERFLAG.NE. Cl RETURN 
WRITE (PRTFIL » 10) NAMe 
10 FORMAT(20H0 GENEALOGY FOR OECK 2A6) 

IF (NLIST. EQ.l) GO TO 40 
DO 23 N = 2, NLIST 

20 WRITE (PRTFIL,30) LIST ( 1,N-1> , LIST( 2 ,N-i> , LIST (1,N) , LIST (2»N) 

30 format c ?h sdeck 2A&,6H uses ,2A&i 

40 WRITE (PRTFIL,S0) LIST (1, NLIST) , LIST( 2 , NLI ST) 

50 FORMAT ( 7H SGeCK 2A6) 

WRITE ( PRTFIL » 6C ) 

60 FORMAT ( 1H0 ) 

RETURN 

ENO 

ELT,I DORMAN. LISTTC 

SUBROUTINE LISTTCtlFILEi 

LIST TABLE OF CONTENTS 

PROGRAMMER - b. GOLD 

DIMENSION XU( 3) ,IR(3) 

COMMON /RiST/TAdL£>US£S|FILE»ENQ,OECK»UDECK»dLANK , BATCH 
INTEGER' TA3 Lc,UScS,FILe,EN0,DcCK,0DeCK, BLANK, BATCH 
COMMON /MISC/ERFLAG,FERR,KARDC1^I ,ACTIGM1«*> 

INTEGER ERFLAG, FERR, ACTION , PRTFIL 
EQUIVALENCE ( PRTFIL >F£RR) 


LISTG 6 
LISTG 7 
LISTG 6 
LISTG 9 
LISTG 10 
MISC 2 
MI3C 3 
MISC * 
LISTG 12 
LISTG 13 
LISTG 1h 
LISTG 15 
LISTG Id 
LISTG 1/ 
LISTG lo 
LISTG 19 
LISTG 20 
LISTG 21 
LISTG 22 
LISTG 23 
LISTG 24 
LISTG 25 
LISTG 26 
LISTTC 3 
LISTTC 5 
LISTTC b 
LISTTC 7 
LISTTC 6 
LISTTC 9 
LISTTC10 
LlSTTCil 
REST 2 

rest 3 

MISC 2 
MISC 3 
MISC ** 
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O' 

I 


INTEGER VERS 


LIST! 


DATA VERS/bHVERSIO/ 

DATA IR/2,2,2/,IU/Q,0,0/ 

IU(1) = IFILE 
CALL INT3UF(IU,IR) 

REWIND iFILt 
cRFLAG - 0 
WRITE ( PRTFIL ,10) 

10 FORMAT<21HO TABLE OF CONTENTS/) 

20 CALL 1NCO(KARO, 1FILE) 

IF (tRFLAG.NE.C ) RETURN 
IF (KARu (5) »EQ.VtRS) GO TO 2? 

IF ( (KARUtl) .NE.UOECK) .ANO. (KARO ( 1) . 


LISTTUl:* 
LIST TCic> 
L 1ST TCI? 
LISTT016 
LISTT019 
L1STTC20 
L 1ST TC21 
LISTTC22 
L 1STTC23 
L ISTTC24 
L1*TTC2» 

•END)) GO TO 6G L1STTC2G 


2 !> CONTINUE 

CALL OUTCO (KARU, PRTFIL) 

IF ( KARU ( 1) • Nt* END ) GO TO 20 
IF(KARO(2) •NE. TABLE) GO TO 20 
Re TURN 

ol) ERFLAG = 1 

WRITE (FERR, 70) KARO 
70 F0RMAT(^9HQLISTL - ERRONEOUS CARO 

♦ 6 ) 


LISTTC27 
LISTTC2S 
LISTTC2 9 
i_ISTTu30 
LISTTC31 
LISTTC32 
LISTTC33 

WITHIN TABLE OF C0NTtNT3-/5X,l4ALXSTTC3‘* 

LISTTC33 


GO TO 2 G 
END 

*ELT, I OORMAN • OPT 

SUBROUTINE OPT 


LISTS THt OPTIONS AVAILABLE 

PROGRAMMER - S. WRAY 

COMMON /MlSC/tRFLAG ,Fc.RR,KAR0( l*) 
INTEGER ERFL AG, FERR, AC TI ON, PRTFIL 
EQUIVALENCE (PRTFIL,F t RR) 

WRITE (PRTFIL, 5) 


LIST TC3o 
LISTTC37 
OPT 3 
OPT :? 
OPT b 
OPT 7 
OPT 6 
OPT 9 
OPT 10 
OPT 11 

ACTICM1*) MISC 2 

MISC 3 
MISC *, 
OPT 13 



I 

LTi 

-si 

I 


5 FORMAT < 25H OPTION LIST (SHORT FORM)/ OPT 

♦57 H 1. CRcATt 2. USt (U) 3. OPTION CO) 4. SAVc (S) / OPT 

*57H 5. A JO (A) 6. DELETE (0) 7. tOIT ( E) 6. CONVERT IC)/ OPT 

♦ 57H 9. REPLACE (R) 10. LIST (L) 11. OQNc 12. TAPE LIST / OPT 

* ) OPT 

9 WRITt (PRTFIL j 1C) OPT 

10 FORMAT ( 3 9H eNTEk NUMBER OF OPTION TO b£ EXPLAINED/ 6H OR DONE/ OPT 

♦9H READY - ) OPT 

15 CALL INCO (KARO, 5) OPT 

IF (KARO (1) • tQ.4HUONt> RETURN OPT 

CALL VALUE (KARO, V, IERR) OPT 

IF ( IERR • EQ. 0) GO TO 20 OPT 

17 WRITE ( PRTFaL, lb) OPT 

16 FORMAT (26H ILLEGAL ENTRY - TRY AGAIN/ 9H REAOY - > OPT 

GO TO 15 OPT 

20 I = V OPT 

IF(I.LT.l) GO TO 17 uPT 

IF(I.GT.12) GO TO 17 OPT 

GO TO (191, 102, 103, 134,105, 106, 107, 106, 1Q9, 110,111,112, 113 OPT 

* ) ,1 OPT 

101 WRITE (PRTFIL, 2Q1) OPT 

201 FORMAT ( 7 1H IF THE KEY WORD -CREATE- IS ENTERED, THE PROGRAM WILL GOPT 

♦ENERATE A 0UHMY/63H DATA BASE AND THEN USE THE ADD OPTION TO ADO OOPT 
♦cCKS FROM T APt2 1/29H CReATt MAY Bt UStL ONLY ONCE) OPT 

GO TO 9 OPT 

102 WRITE (PRTFIL, 202) OPT 

202 FORMA T ( 7 1H If THE KEY WORD -USE- IS ENTERED, THE PROGRAM WIlL REQUOPT 

♦tST THe NAMc OF/7<*H A OtCK TO Be EXTRACTED FROM THE DATA BASE. THOPT 
♦ERE WILL BE A DELAY FOR THE/11H EXTRACTION) OPT 

GO TO 9 DPT 

103 WRIT£<PRTFlL,203) OPT 

20 3 FORMAT ( 7 OH IF THc KtY WORD -OPTION- IS ENTEREO, THE USER IS PROVIOOPT 

♦ED WITH A LIST/68H AND THE DESCRIPTION OF EACH ITEM IN THE LIST ASOPT 

♦ REQUESTED VIA INPUT) ' OPT 

GO TO 9 DPT 

104 WRITE (PRTFIL, 204) DPT 


1 4 

15 

16 
17 
lo 

19 

20 
21 
22 

23 

24 
2 ? 
2o 

27 

26 

29 

30 

31 

32 

33 

34 

35 
3o 
37 

36 

39 

40 

4 1 

42 

43 

44 

45 

46 

47 
46 
49 



I 

Ui 

00 


2Q *» FuRMAT(72H IF THc Kc Y WORD -SAVc- IS cNTtKtQ, THE USER WILL HAVE TOPT 
♦HE CAPABILITY T0/71H SAVE THE HOST RECENT VERSION OF THE DATA BASE OPT 
♦ OR SAVE A BASIC DECK FOR/60H INPUT TO DORCA OR SAVE A NOD DECK TOOPT 


♦ 3E RETAINED EXTERNALLY) 

GO TO 9 

105 WRITE <PRTFIL,2C5> 

205 FORMAT ( 7 1H IF THE KEY WORD -ADD- IS 
*N TO LOAD D£CKS/*2H FROM TAPe21 FOR 
GO TO 9 

106 WRITE (PRTFIL,2C6) 

236 FORMA T ( 7 IH IF THE KEY WORD 
♦cQUcST THc NAME / 72H OF THc 

♦ THE DECK IS THEN DELETED) 

GO TO 9 

107 WRITE (PRTFIL, 207) 

207 FORMAT ( 7 1H IF THc Kc Y WORD 

♦ TO NAME A DECK/71H IN THE 


ENTERED, 

ADDITION 


THE PROGRAM 
TO THc DATA 


-DELcTe- 
OcCK TO 


IS ENTERED, THE PROGRAM 
BE DtLtTcO FROM THt DATA 


-EDIT- IS 
DATA BASE 


cNTERtO, 
AND THEN 


THc USER IS 
ENTER A HOD 


OPT 

OPT 

OPT 

WILL BEGIOPT 
BASE) DPT 
OPT 
OPT 

WILL ROPT 
BASE. OPT 
OPT 
OPT 
OPT 

OIRcCTEDOPT 
DECK VIAOPT 


♦ THE TERMINAL WHICH WILL/A3H ALTER THE ORIGINAL DECK VIA THE USE OOPT 
♦PTION) OPT 

GO TO 9 OPT 

10.) WRITE (PRTFIL,203) OPT 

203 FORMAT ( 73H IF THE KEY WORD -CONVERT- IS ENTERED, THE PROGRAM WILL OPT 
♦REQUEST THE NAMES/7 EH OF TWO DECKS IN THE DATA BASE. THc TWO DcCKOPT 
♦S WILL Be COMPARED CARD BY CAR0/7*H AND A MOO OECK WILL BE GENERATOPT 
♦ED THAT WILL BE SMALLER THAN THE BASIC DECK/68H BUT EQUIVALENT IN OPT 
♦DATA CONTENT WHEN APPLIED TO THE OTHER BASIC DECK) OPT 

GO TO 9 OPT 

109 WRITE ( PRTFIL * 209) OPT 

209 FORMAT! 7 AH IF THE KEY WORD -REPLACE- IS ENTERED, THE USER WILL BE OPT 

♦ALLOWED TO REPLACE/63H A OECK IN THE DATA BASE IF THERE IS NOT A MOPT 
*OD DeCK NEEDING THE/1**H ORIGINAL OECK) OPT 

GO TO 9 OPT 

110 WRITE (PRTFIL, 210) OPT 


210 FORMAT! 53H IF THE KEY WORD -LIST- IS ENTERED, THE USER CAN 
* 36H TABLE OF CONTENTS OF THE DATA BASE ✓ 

♦hOH GENEALOGY OF ANY OECK IN THE DATA BASE / 


LIST/ 


OPT 

OPT 

OPT 


50 

51 

52 

53 

55 

5o 

57 

5 a 
59 
63 
61 
62 
63 
6<» 

65 

66 
67 
66 

6 9 

70 

71 

72 

73 
7* 
7 ’5 

76 

77 
73 
79 

30 

31 

32 
83 
8* 
35 



n o o o o o o 


• 

U1 

vD 

• 


*4dH 

COUNT 

OF CARDS ON ANY TAPE USEO BY THE 

PROGRAM / 

OPT 

86 

*50H 

INDIVIDUAL CARDS ON ANY TAPE 

USEO BY 

THE PROGRAM / 

OPT 

67 

♦55H 

PRINTOUT OF THE COMPLETE CONTENTS OF 

ANY TAPE OR DECK ) 

OPT 

86 

GO 

TO 9 





OPT 

89 

111 WRITE (PRTFIL, 211) 




OPT 

90 

211 FORMAT ( 5 6H 

IF THE KEY WORD - GONE 

- IS ENTeRlD, THe PROGRAM TtRMINAOPT 

91 

*tS> 






OPT 

92 

GO 

TO 9 





OPT 

93 

112 WRITE (PRTFIL, 212) 




OPT 

94 

212 FORMAT(V4H 

THIS IS A LIST OF TAPESUSEO BY 

THt PROGRAM/ 

OPT 

99 

*o2H 

TAPE1 

- SOURCE DATA BASE 

TAPE1* 

- 

CURRENT BASIC DECK 

/OPT 

9b 

*62H 

TAPE2 

♦ ALTERNATE OAT A 3ASE 

TAPE20 


OUTPUT DECK LISTINGS 

/OPT 

97 

*62H 

TAPE 3 

- ALTERNATE DATA BASE 

TAPE21 

- 

INPUT BASIL DECKS 

/OPT 

98 

♦62H 

TAPc* 

- SAVED OATA BASc 

TAPc22 


SCRATCH 

/OPT 

99 

*62H 

TAPe5 

- CONSOLE INPUT 

TAPE23 

• 

SCRATCH 

/OPT 

100 

*62H 

TAPE 6 

- CONSOLE OUTPUT 

TAPE24 

- 

SAVED MOD DECKS 

/OPT 

101 

* 62H 

TAPE 11 

- INPUT MOD OECKS 

TAPE25 

- 

SCRATCH 

✓ OPT 

102 

♦&2H 

TAPE12 

- DORCA OATA DECK 

TAPE26 

- 

SCRATCH 

/OPT 

103 

*o2H 

T APE 1 3 

- CURRENT MOO DECK 

TAPE27 

- 

SCRATCH 

/OPT 

104 

*) 






OPT 

109 

GO 

TO 9 





OPT 

106 

113 WRITE (PRTFIL, 213) 




OPT 

10/ 

213 FORMAT ( 4H 

13.) 




OPT 

108 

GO 

TO 9 





OPT 

109 

cND 






OPT 

110 

FELT, I DORMAN. OUTCO 




OUTCO 3 


SUBROUTINE OUTCU (ICRD,IUNIT) 

PUT IN FORCc CLOSe 

MODE 1 - WRITE 95 CAROS 
MODE 2 - WRITE 1 CARD 

PROGRAMMERS VOIT 

COMMON /REST/TA6LE, USES, FILE, END, DECK, D0ECK,3LANK , BATCH 
- iNTcGtR TABLE, USES, FILE, END, OECK,OQECK, BLANK, BATCH 


OUTGO 5 
OUTGO o 
OUTGO 7 
OUTCO 6 
OU7CO 9 
OUTGO 10 
OUTGO 11 
OUTCO 12 
REST 2 
REST 3 



non o o o 


COMMON /MISC/tRFLAG,FcRR,KARD(l4> ,ACTI0N(14) 

INTEGER ERFLAG,FERR,ACTION,PRTFXL 
EQUIVALENCE (PRTFIL ,FERR> 

COMMON / WORK/ 1 1 UNT ( 3) , IIRW(3) , IUTBL(3,19) , I ACT 16,3) ,NFIL£S 
COMMON /3FRS/ XXX(54> 

COMMON /3FRS/ IM001(14,5&,2),IHK1(168,2), IT EMP1 ( 8*) , ITEMP2 (84) 
DIMENSION ICRG ( l*t ) 

DIMENSION ITMPKd-r) ,ITMP2( 8 h) 

tOOI VALENCE ( 1 TMP1 ( 1) , ITEMPKD) , (HEMP 2(1) ,ITMP2(1)) 

DATA II X, IIY,IIZ 714,55,2/ 

DATA IIW / 8 4/ 

IF( IUNIT .cQ.b) GO TO 6 
CALL FN030F ( IUNI T , I X, I Y) 

IF (IX.Nt.2) GO TO 100 

MOOc cQ 2 - WRITE ONt CARO 

IF (IACT(4,IY) .tQ.l) GO TO 510 
8 CONTINUE 
DO 2 1=1,14 
J=1 5 -I 

IF(ICRO (J) .NE. BLANK) GO TO 3 

2 CONTINUE 

3 CONTINUE 

IF ( IUNI T • £Q« 6) GO TO 10 
WRITE (IUNIT, 5) ( ICRO( I) ,1=1, J) 

5 FORMAT ( 14 Ao) 

IFdCRO(l) .Nt.ENO) RETURN 
IF(ICRO(2) .NE.FILE) RETURN 
IACT (4, IY) = 1 
tNO FILE IUNIT 
RETURN 

SPECIAL FORMAT FOR TERMINAL OUTPUT 
10 WRITE (IUNIT, 11) (ICRO (I) , 1=1, U) 


MISC 2 
MISC 3 
MISC *t 
WORK 2 
BFRS 2 
bFRS 3 
OUTGO 17 
OUTGO 18 
OUTGO 19 
OUTGO 20 
OUTGO 21 
OUTGO 22 
OUTGO 23 
OUT CO 24 
OUTGO 25 
OUTGO 26 
OUTGO 2 7 
OUT CO 23 
OUTGO 29 
GUTCO 30 
OUTGO 31 
OUTGO 32 
OUTGO 33 
OUTGO 3«* 
OUTCO 35 
OUTGO 3o 
OUTCO 37 
OUTCO 36 
OUTCO 3^ 
OUTCO 40 
OUTGO *<-1 
OUTGO 42 
OUTGO 43 
OUTGO 4** 
OUTGO 45 
OUTCO 46 



no ooo ooo ooo ooo 


11 FORMAT (IX, 1hA6) 

RETURN 

MODE l 

100 CONTINUE 

IF(IX.Nc.l) GO TO 500 
IXX = I ACT ( 8 » I ¥) 

IYY = IACU7,IY> 

IF (IXX.LT.IIW) GO TO 120 

MOVE 64 CHAR FRCM WORK AREA INTO BUFFER 

CALL A1TA6 ( I WK1( 1 , IY) , IMOQ1 ( 1 , 1 Y Y , I Y) ) 

IXX - IXX-6** 

IYY = IYY+1 

MOVE REMAINING CHAR DOWN 

JO 110 1=1, IXX 
IZ = I+b4 

IWK1 1 1 » I Y) = I WK1 ( IZ , I Y) 

110 CONTINUE 

MOVE NEW CARO INTO WORK AREA 

120 CONTINUE 

CALL AbTAl ( ICkU , IT MP1 ) 

CALL PACCONUTEMP1, ITMP2,ICH> 

00 130 1=1, ICH 
ICH1 = IXX + I 

IWK1 ( ICH1 , 1 Y) = ITMP2 ( I) 

130 CONTINUE 

IXX = IXX+ICH 

CHECK FOR END OF FILE 


OUTCO * 7 
OUT CO 4b 
OUTGO 49 
OUTCO 50 
OUTCO 51 
OUTGO 52 
OUTCO 53 
OUTCO 54 
OUTCO 55 
OUTCO 5o 
OUTCO 57 
OUTCO 5o 
OUTGO 59 
OUTCO 60 
OUTCO 61 
OUTCO 62 
OUTCO 63 
OUTCO 6** 
OUTCO 66 
OUTCO oo 
OUTGO 67 
OUTCO 6b 
OUTGO 69 
OUTCO 70 
OUTGO 71 
OUTGO 7 ^ 
OUTCO 73 
OUTGO 7 * 
OUTGO 79 
OUTCO 7o 
OUTCO 77 
OUTCO 7b 
OUTCO 79 
OUTCO bO 
OUTCO bl 
OUTGO 62 



c 


IACT(7,IY) = IYY 
XACT ( 6 , 1 Y) - IXX 

IF ( ICRO < 1) . Nt . 6HSEN0 0 ) GO TO 135 
IF ( ICRO ( 2) . £Q. 6HF FILE ) GO TO 150 
135 CONTINUE 

IF(IYY.GT.IIY) GO TC IhO 
RE TURN 

140 CONTINUE 

□0 1-5 1=1, IIY 

WRITE IIUNIT,5) < IM COl ( L , I , I Y) , 1=1, 14) 
1 h5 CONTINUE 

IAC T ( 7 , IY) = 1 

RETURN 

C 

C MOVE WORK AREA INTO BUFFER ANO 

c blank remaining auFFtR 

c 

I 15C CONTINUE 

ft IACT ( 4, I Y) = 1 

' K = <2*liW)-IXX 

Kl= 2* I I W 
00 155 I=K,K1 
IWK1 ( I, IY) = 6H 
155 CONTlNUt 

CALL AlTAo ( IWK1 ( 1, IY) , IMOOI (1 , I YY, I Y) ) 
IS = IYY+1 
DO 170 I=IS, II Y 
00 165 J=1,14 
IHOCKJ, I, IY) = 6H 
165 CONTINUE 
170 CONTlNUt 

00 160 1=1,55 

WRITE ( IUNIT ,5) (IMCOl (L,i, IY) ,L=l,l4) 
130 CONTlNUt 
RETURN 


OUTGO 63 
OUTGO 6-» 
OUTGO 65 
OUTGO 66 
OUTGO 67 
OUTGO 66 
OUTGO 6* 
OUTGO 9 J 
OUTGO 91 
OUTGO 92 
OUTCO 93 
OUTGO 94 
OUTGO 95 
OUTCO 96 
OUTCO 97 
OUTCO 96 
OUTCD 99 
OUTCD10G 
UUTCO101 
0UTG01C2 
UUTGU103 
OUTCOiO- 
OUTCOl 0 ? 
OUTCOldo 
OUT GDI 1)7 
OUTCOl 06 
0UTC0169 
OUTCD110 
OUTCOlll 
OUTG0112 
0UTC0113 
OUTGOll- 
0UTC0116 
0UTG0116 
OUTCOlll 
OUT C0116 



o o o o -r nno 


ERROR EXIT 

500 CONTINUE 

WRITt (FcRR»10C0) IUMT,IX 

1000 FORMAT < 2 7H OUTCD - MODE ERROR -- UNIT, 13, 5H MODE, 13) 
ERFLAG = 1 
CALL TtRM 
5 1G CONTINUE 

WRITE (F£RR,1C1C) IUNIT 

1010 FORMA T ( 26H OUTCD - END OF FILE ON UnIT, 13I 
ERFLAG = 1 
CALL TERM 
RETURN 
tNQ 

ElT,I oorm an « paccon 

SUBROUTINE PACCON ( CHAR,GCH AR, NCHAR) 

PACK CAROS WITH = AND ? 

PROGRAMMER - S. WRAY 

iNTtGcR CHAK(ttO) ,GCHAR(80) ,PKTA8<9,2) 

DO 5000 1=1, BC 

IF (CHAR (I) «EQ.1H=) CHAR(I) = 1H- 
IF(CHARCI) .EQ.1H?) CHAR(I) = 1H 
5000 CONTINUE 

OO 5 I = 1,80 
J = 81 - I 

IF(CHAR(J) .NE.1H ) GO TO 10 
5 CONTINUE 
NCHAR = 1 

5 ochar(nchar)=ih; 

RETURN 

10 NCHAR =81-1 
PKT Ad (1 , 1 ) = 1 
NPK = 0 


uUTCDll 9 
OUT CO120 
OUTCD121 
OUT CD122 
0UTC0123 
OUTCU12* 
OUTC012? 
OUTCOl 2u 
0UTCD127 
OUTCD128 
0UTCD129 
0UTC013D 
OUTCD131 
OUTC0132 
OUTCD13 3 
PACCON 3 
PACCON y 
PACCON o 
PACCON 7 
PACCON 8 
PACCON 9 
PACCONiO 
PACCON11 
PACCON12 
PACCON13 
PACCON1-* 
P ACCUNl j 
PACCONlo 
PACCGN17 
PACCONlo 
PACCON19 
PACCGN2U 
PACCON21 
PACC0N22 
PACCON23 
PACCCN2-* 



o o n o o 


O'- 

I 


oo ii 1=1, a 

DO 12 J=1,1Q 
L = 10*1 ♦ 1 - J 
IF<L.G£. NCHAR) GO TO l*t 
IF ( CH AK ( L) . NE. 1H ) GO TO 13 

12 CONTINUE 
L = L-1 

13 IF(J.EQ.l) GO TO 11 
CHAR<L+1> = 1H= 

NPK=NPK+1 
PKTA3(NPK#2)= L+l 
PKTAB(NPK+1,1> = 1G*I +1 

11 CONTINUE 
GO TO 15 

14 NPK = NPK+1 

PKT A3 (NPK , 2) = NCHAft+1 
CH Aft ( NCH AR + i) = lH? 

15 NCHAR = 0 

00 lb L= 1 ,NPK 
L1=PKTAB(L,1) 

U2=PKTA8(L,2) 

00 17 K=Ll,L2 
NCH AR=NCH AR+i 
OCHAR (NCHAR) =CHAR(K> 

17 CONTINUE 

16 CONTINUE 
RETURN 
END 

FELT I DORMAN «R£PL 

SUBROUTINE REPL 


CONTROLS REPLACEMENT OF OECKS 


PROGRAMMER - S. WRAY 

COMMON /MISC/tRFLAG , FtRR, KAROC 14) ,ACTIONtiA) 


PACCCN25 
PACCCNEo 
PACC0N27 
PACC0N2B 
PACC0N29 
PACC0N3U 
PACC0N31 
PACC0N32 
PACC0N33 
PACC0N34 
PACCCN3S 
PACC0N3© 
P ACCOM 3 7 
PACC0N33 
PACCON39 
PACC0N49 
PACC0N41 
P ACC ON >♦ 2 
P ACC ON 4 3 

PACC0N44 
PACCQN4© 
PACC0N4O 
PACC0NA7 
PACO ON 4 A 
P ACC ON* 9 
PACCON50 
PACC0N5L 
PACC0N52 
REPL 3 
REPL » 
REPl o 
R tPL 7 
REPL a 
REPL 9 
REPL 10 
MISC 2 




INTEGER ERFLAG, F£RR, AC TICN,PRTFIL 




MISC 

3 


tQUlVALcNCt (PRTFIL ,Ft RR) 




MISC 

** 


COMMON /FILES/ 6A;>IC,MTAP£ , FINAL , SI, S2 




FILES 

2 


INTEGER 3 ASIC, MT APE, FINAL, SI, S 2 




FILES 

3 


COMMON /NAMES/ IVER,DNAME(2) , M0DNAM12) , BNAMc. (2) 




NAMtS 

2 


INTEGER UNAMc, M GO NAM, BNAME 




NAMES 

3 


DIMENSION IU(3),IR(3) 




REPL 

14 


DATA IU, IR/0,0, 0, 2, 2,2/ 




REPL 

1» 


WRITtCPRTFIL, 5) 




RcPl 

16 

5 

FORMAT ( 30H ENTER NAME OF DECK TO BE USED/9H READY - ) 




REPl 

17 


CALL INCO (KARO, 5) 




REPL 

16 


Ml = 13 




REPL 

19 


1 = 0 




REPL 

20 


M2 = 1** 




REPl 

21 


IF ( (KARO ( 1) . ECU MOON AM<1>>, AND. (KARO (2) .EQ.MOONAM (2) } ) 

I = 

Ml 


REPL 

22 


IF{ (KARD(l) .EQ.BNAME l 11 ) . AND . ( KARO (2) . EQ.B NAME (2))) 

I = 

M2 


REPL 

23 


IFU.Nt.0) GO TO 20 




REPL 

2*t 


WRITE (PRTFIL,15> 




REPL 

26 

15 

FORMAT ( 2hH ORIGINAL DECK NOT FOUND) 




REPL 

26 


ERFLAG = 1 




RcPL 

27 


RETURN 




REPL 

26 

20 

CONTINUE 




REPL 

29 


WRITE <PRTFIL,ia> 




REPL 

30 

10 

FORMAT ( 34H ENTtR NAME OF DcCK TO 8fc RtPLACt U/9H RtADY 

- ) 



REPL 

31 


CALL IN CD (ACTION, 5) 




REPL 

32 


IF ( (KARD(l) ,EQ. ACTION ( 1) ) .AND. (KARD( 2) . ED. ACTION ( 2) ) 1 

GO 

TO 100 

REPL 

33 


WRITt ( PRT FIL , 25) 




REPL 

3*+ 

25 

FORMAT <2*H DECK NAMES DO NOT MATCH/ 38H REQUEST REJECTED - 

USE 

OELEREPL 

35 


*TE AND ADO) 




REPL 

36 


ERFLAG = 1 




REPL 

37 


return 




REPL 

36 

100 

CONTINUE 




REPL 

39 


SI = BASIC + 1 




REPL 

EG 


IFIS1.GT.3) SI = 2 




RtPL 

Ll 


IU(1) = BASIC 




REPL 

*2 


IU ( 2) = SI 




REPL 

43 



oooo o ooooo 


IU13) = I 
RE WINU I 
REWIND SI 

CALL INT8UF(IU,IR) 

CALL REPLAC <6ASIC,I,S1> 

IF(ERFLAG.NE.C) RETURN 

BASIC = SI 

RETURN 

END 

*tLT,I DORMAN .REPLAC 

SUBROUTINE REPLACdM, IN2, OUT) 

SUBSTITUTE DECK WHICH IS NEXT ON FILE IN2 FOR THE DECK OF THE SAME 
NAME WHICH IS ON THE BASIC OATA FILE INI. COPY THt RtVlSt.0 BASIC OATA 
FILE ONTO FILE OUT. 

PROGRAMMER - 6. GOLD 

COMMON /MISC/ERFLAG , FE RR, X A RO C 14 ) ,ACTIGN(14) 

INTEGER ERFlAG, PE RR, ACT ION, PRTFIL 
EQUIVALENCE (PRTFIL, FERR) 

INTEGER OUT 


INTEGER TYPE, FLAG, 8ASIK, MOO, TEMP( 14) 

COMMON /REST/TABLt, USES, FILE, END, DECK, OOECK, BLANK , BATCH 
INTEGER TABLE, USES , F IL E , END ,OECK , OOECK , 6L ANK,6A TCH 
INTtGtR VtRS 
DATA VcRS/6HV£RSI0/ 

DATA 6 AS IK , MOO / 5H8ASIC, 3HM00 / 

INITIALIZE FILES. READ FIRST CARO OF NEW DECK AND VERSION CARD FROM 
OATA FILE. 

FLAG = i 
REWIND INI 
REWIND OUT 

erflag = 0 

CALL IN CO (KARO, IN 2) 


RtPLAClB 
REPLACl* 
REST 2 
REST 3 
REPLAClo 
REPlACI 7 
REPLACld 
REPLAC19 
REPLAC20 
REPl AG21 
RcPLAC22 
REPLAC23 
REPLAC24 
REPLAC2B 
REPLAC20 
REPLAC27 



o o o o 


t 


K0UNT2 = 1 

IF (ERFLAG.NE.fi) GO TO 100 
TYPE = BASIK 

IF (KARO(a) .EQ.USES) TYPE = MOD 
IF (KARD(l) .NE.OOECK) GO TO 110 
NAME1 = KARO (2) 

NAME2 = KAR013) 

CALL tXTRAN (KAR0(7) ,KARO( 9) ) 

WRITE (PRTFIL,10) KARO ( 2) » KARO(3> 

10 FORMAT (20HOREPLACE DECK NAMED ,2A6,13H ON DATA FILE/) 

CALL OUTCU (KARD.PRTFIL) 

IF ( ( KARO( 2) • tQ. KARO (?) ) .AN0.(KARD(3) . EQ. KARD (fc) ) ) GO TO 170 

KOUNT 1= 0 

COPY TABLt OF CONTENTS. CHECK TO Set THAT RtPLACcMtNT OeCK ANO ANY 
DECK IT USES ARE LISTED AMONG CONTENTS. 


FLAG = 2 
iNDtX = 0 
NEED = 0 
LASTM = 0 
NT C = C 
IUSt = 0 

30 CALL INCD(TEMP,iNl) 

IF (ERFLAG.NE.O) GO TO 120 
KOUNT 1 = KOUNT 1+1 
IF (T£MP(1) .EQ.ENO) GO TO AO 
IF(T£MP(5) .EQ.VcRS) GO TO 30 
IF (TEMP(l) .NE.OOECK) GO TO 150 
NTC - NTC+1 

IF (TEMPU) .EQ.USES) LASTM = NTC 

IF ( (KARO (2) .EQ.TEMP(5) ) . A NO. ( KARO ( 3) . EQ. TEMP (t>) > ) 
IF ( ( T£MP( 2) . EQ.KARO (5 ) ) . A NO . ( TEMP ( 3) . EQ.KARO ( b) ) ) 
IF ( (TtMP(2i . EQ.KARO (2 )> . AN D . ( TEMP ( 3) . EQ. KARO ( 3) ) ) 
GO TO 30 


1USE = NTC 
NEED = NTC 
IN0£X= NTC 


REPLAC26 
REPLACE* 
REPLAC3Q 
KEPLAC31 
REPLAC32 
REPLAC33 
REPLAC3* 
REPLAC35 
REPLAC3o 
REPLAC37 
R£PlAC3o 
REPLAC3* 
REPuACaO 
REPLACE 
RcPLAC**2 
REPLAC*»3 
REPLACAa 
REPLACES 
REPLAC*to 
REPLACE 
REPLACho 
REPLACE 
REPLAC5D 
REPcAC51 
REPLAC52 
RtPL AC53 
RePLAC5-» 
REPLAC55 
REPL AC5o 
RePL AC57 
REPLACES 
k£PlAC59 
REPLACou 
REPLACol 
REPLACoE 
REPLAC63 
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DECIDE WHERE TO INSERT NEW SOECK CARO IN T ABLt OF CONTENTS 

40 LOC = INDEX 

IF (INDEX. EQ. 3) GO TO 130 

IF < (NctD.tQ.G) .AND. (T YPt . EQ. MOD) ) GO TO 1**G 

IF ( (NEtO.GT.G) .AND. (NEED. LT.IUSE) ) GO TO lbO 
INDEX = IUSE+1 

IF (TYPE.EQ.BASIK) INDEX •= NTC 

READ TABLE OF CONTENTS AGAIN AND COPY QNTG OUT FILE WITH NEW *G£CK 
CARO INSERT AND OLD ONE DELETED 

RtWINO INI 
KQUNT1 = 0 
K0UNT3 = a 

45 CALL INCO( TEMP, INI) 

IF (cRFLAG.Nt.O) GO TO 120 
KOUNT1 = KOUNT1+1 

IF( (TEMP(2) *£Q. NAMED . AND • (TEMPO) .£Q*NAMc2)) GO TO *5 
IF (INOEX.NC..KOUNT3) GO TO <+7 
CALL OUTCD(KAROjOUT) 

K0UNT3 = K0UNT3+1 
47 CALL OUTCD( TEMP, OUT) 

K0UNT3 = K0UNT3+1 

IF ( (T£MP( 1) .NE.END) .OR. (TEMP (2) .NE. TABLE) ) GO TO 45 

COPY ALL DECKS FROM INI TO OUT EXCEPT DECK TO BE REPLACED. 

INScRT NtW DECK WHtN OtCK COUNT NOECK = NUMBER 

FLAG = 3 
NOECK = 0 

IF ( ( TY Pc. , t Q.MGQ ) .AND. (LOC.LE.LASTM) ) NUMBER = LAS TM-INOEX+1 

IF ( (TYPE. EQ. MOD ) . AND. (LOC.GT .LASTM) ) NUMBER « LASTM-INDE X+2 

IF ( (TYPE.EQ.BASIK) .AND. (LOC.LE.LASTM)) NUM3ER = LASTM 

IF ( (TYPE.EQ.BASIK) .AND. (LuC. GT. LASTM) ) NUMBtR - LASTM ti 

50 CALL INCDC TEMP, INI) 


REPLACo*. 
REPLACE? 
REPLACE© 
REPtACo? 
REPLACES 
REPLAC69 
REPLAC7 J 
RcPLAC7l 
REPLAC72 
REPLAC73 
REPLAC74 
REPLAC75 
REPLAC7o 
REPLAC77 
REPLAC7B 
REPLAC7 9 
REPLACdu 
REPLAC81 
REPLAC32 
RcPLACd 3 
REPLACd** 
RcPLACd? 
REPlACBo 
REPLAC87 
REPLACati 
REPLAC89 
REPLAC90 
REPLAC91 
REPLAC92 
REPLAC93 

replace 

REPLAC9? 

REPLAC9o 

REPLAC97 

REPLAC9B 

REPLAC99 



ooo nooo ooo 


IF ( ERFLAG . N£ • Q) GO TO 120 


kcPLAIQO 


K0UNT1 = KOUNTl + 1 

IF (TEHP(l) .NE.DQECK) GO TO 63 

ISKIP - 0 

IF ( (TEflP(2) .£Q. NAMED .AND. (T£MP<3) .EQ.NAME2) ) ISKIP = t 
IF (ISKIP. EQ.l) GO TO 60 
NOECK = NDECK-t-1 

IF (NDECK.NE. NUMBER) GO TO 60 
TRANSFER Nt W DECK ONTO OUT FILE 

55 flag = + 

CALL DU T CD ( KARO » OUT) 

60 CALL INC0(KAR0,IN2) 

IF (ERFLAG.NE.O) GO TO 100 
K0UNT2 = KOUNT2+1 
CALL OU ICC ( KARO * OUT) 

IF (KARO(l) .NE.ENQ) GO TO 60 
WRITE (PfiTFILj 70 K0UNT2 
70 FORMAT! /IlQ , 6H CAROS) 

FLAG = 5 

00 NOT COPY THIS CARO ONTO OUT FILE IF IT IS PART OF THt OLD OtCK TO 
BE REPLACEO (IF ISKIP=1) 

60 IF (ISKIP. EQ.O) CALL GUTC 0 ! T EMP , OUT) 

IF ( (TtMPC 1) .Nt .ENO) .OR. (T C MP(2) .Nt.FlLt) ) GO Tu 50 
IF (ISKIP. EQ.l) CALL GUTCQ(T£rtP,OUT> 

RETURN 

ERROR STOPS 

100 WRITE (FERR, 1C5) 

105 FORMAT ( 2 3HQ ERROR READING FIlE IN2) 

GO TO 200 

110 WRITE (FERR, 115) 


REPLA101 
REPLA102 
REPLA1 0 3 
REPlAIO* 
REPL A10 > 
RtPLAlOo 
REPLA10 7 
RLPLA136 
REPLA105 
REPLA110 
REPLA11 1 
REPLA112 
REPLA11 3 
RtPLAil** 
RtPLAll ? 
RtPLAllb 
REPLA117 
REPLA116 
REPLA11S 
REPLA120 
REPLA121 
RtPLA122 
REPLA123 
REPLA12 h 
REPLA 123 
REPLA126 
REPLA127 
REPLA126 
REPLA129 
REPLA13 0 
REPLAlil 
REPLA132 
RtPLA133 
REPLA13* 
REPLA135 



non 


i 

-0 

0 

1 


C 


115 FOKMAH37HOFIRST CAkO ON FILE IN2 IS NOT iCECK ) 

GO TO 200 

12!) WRITE ( FERR, 125) 

125 FORMAT (23HOERROR READING FILE INI) 

GO TO 200 

13!) WRITE (F£RR,135) KARJ(2), KARO (3) 

135 FORMAT ( 22HQ OtCK TO at RcPLACtO (,2A6,36H) IS NOT LISTtD IN TABLt 
*F CONTENTS) 

GO TO 200 

141) WRITE (F£RR,1l5> (KARO(I), 1=1,6) 

1*5 FORMA T( 52H0DtCK TO Be AODeD USES OtCK NOT IN TABLE OF CONTENTS/ 

* 5 X i 6A6 ) 

GO TO 200 

150 WRITE (FERR, 155) 

155 FORMAT(5QH()ILLLGAL CARO WITHIN TABLE OF CONTENTS ON FILE INI) 

GO TO 203 

160 WRITE (FERR, 165) (N AME 1, NAME2, J=l,3) 

165 FORMAT (63H0tRR OR IN OtCK POSITIONS DISCOVERED DURING RtPLACtMENT 
IF OECK 2A6/17H DECK WHICH USES 2A6,22H FOLLOWS DECK USED BY 2A6) 
GO TO 200 

17(1 WRITE (FERR, 175) 

175 FORMAT ( 17H0DtCK USES ITSELF) 

200 ERFLAG = 1 

ADVANCE FILE IN2 TO tND OF CURRENT OECK 
ERFLAG = 0 

210 IF (KARO(l) .tQ.ENO) GO TO 220 
CALL INCO ( KARO , IN2) 

KOUNT2 = KOUNT2 ♦ 1 
IF (ERFLAG. £Q. 0) GO TO 210 
WRITE (FERR, 105) 

220 ERFLAG = 1 
RETURN 
END 


REPLA136 
REPLA137 
RcPlA 136 
R£PLA13<) 
REPL Al*(l 
REPLAitJ. 

QRtPLAl*2 
REPLA143 
REPLA1**A 
REPLAU5 
R£PLA1*6 
REPLA147 
R£PLA1*6 
REPL A1*B 
REPLA150 
REPLA151 
REPLA152 

0REPLA153 
REP LA15* 
REPLA155 
REPLA136 
KEPLA157 
REPLA150 
REPLA15B 
RtPLAlbO 
REPLAIojL 
REPLAlo2 
REPLA163 
RtPLAlb* 
REPLAlo;» 
RtPLAlbO 
RtPuAlb? 
KcPLAlod 
REPLAloB 
REPLA170 
REPLA171 
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C 

C 

C 

C 

C 

C 

C 

C 

c 

c 

c 


I 

-J 


c 

c 

c 


I DORMAN. NESTOR 

SUBROUTINE RESTOR ( 8UF , NC, NL , FILE , NCNOW) 

REPOSITION CARO FILE, PLACES THE DESIRED CARO 
FIRST IN BUFFER AND FILLS BUFFER 

UPON ENTRY 

6UF BUFFER TO BE FILLED 

NC NR OF CARD TO BE AT POSITION 1 

NL NR OF CARDS IN BUFFER 

FILc TAPE NUMBER 

NCNOW CARu NUMBER CURRENTLY IN POSITION 1 

INTEGER MAX 


kEST GRM3 
RESTORMs 
REST OKMo 
RESTGRM7 
REST GRH6 
REST GRM9 
RESTGR10 
RESTQR11 
RESTOK12 
RtST 0R13 
REST GRln 
REST ORlB 
RESTORlb 
RtSTGRl/ 


INTtGcR ENO REST Gkld 

INTEGER BUFjFILt REST0R19 

DIMENSION 8UF ( 1h, 20 ) RtSTOREG 

COMMON /WORK/ HUNT t 3) , IIRW ( 3) , 1UTBL(3,19) , I ACT (8,3) ,NFIL£S WORK 2 

COMMON / 3FRS/ IS YN ( 2 ,2 0 > , I S YN1 , 1 T1 , 1 T2 , I T 3 , FULL , CNl , CN2 , UNI , L1N2 BFRS1 2 
* , N WBUF , NBi j NB2 , 1 CN 1 , 1 CN2 BFRS1 3 

COMMON /BFRS/ BUF 1 { l<+» 50) , 8 UF 2(14,50) , AAA C 7 00 > BFRS1 4 

INTEGER CNi ,CN2 , BUFi , BUF2 QFtiSl b 

LOGICAL FULL BFRSi o 

EQUIVALENCE ( NWBUF , MAX) RESTOR22 

IF (NC. EQ.NCNGW) RETURN kcSI0i<23 


NNC = NC 
NNQN = NCNOW 


REST GR2* 
RtSTGR2> 


ENO = NL R£STOR2o 

IF (NNC .GT .NNOW) GO TO 10C RESTOR27 

REST OR2B 

CARO HAS PREVIOUSLY BEEN READ RESTGR29 


REWIND FILE 

CALL FNDBUF(FILt,IX,IY) 
I ACT (*♦, IY) = 0 
NNC = 1 


RESTOR3Q 
RtSTORBl 
6WT3 2 
GWT3 3 
RESTCR32 



o o o o o 


NNO W= 1 

1G CONTINUE 

CALL FIlBUF < i»ENQ,MAX,BUF, FILE) 

NL = ENO 

IF (NC.EG.NNC) RETURN 
100 CONTINUE 

IF (NC.LE.NNOW+ENO-1) GO TO 120 
NNC = N N 0 W ♦ £ NO 
NNO H= NNC 
GO TO 1G 
120 CONTINUE 

N = NC-NNOW 

C MOVE CAROS UP, PLACING NC INTO POSITION 1 

K = C N0 - N 
DO 1*0 1 = 1, K 
L= N+I 

00 130 J=1,1L 

3UF ( J , I > = aUF(J,L> 

130 CONTINUE 
1*0 CONTINUE 
NL = K 

IF(8UF(1,K) • hQ» 6H$t NO 0) RETURN 
K = K+l 

CALL FIL3UFCK, ENO, MAX, BUF, FILE) 

NL = END 
Rt TURN 
ENO 

9ELT , I OORMAN. SAVER 

SU3RQUT INE SAVER 

SAVE NECESSARY FILES/OECKS 

PROGRAMMER - S. HRAY 

DIMENSION IU (3) , IRC 3) 

COMMON /MISC/ERFLAG,FERR,KARO(lA) ,ACT10N(1E) 


RESTCR33 
GHT13 9 
GHT13 b 
GMT 13 7 

RESTGK36 
REST OR37 
RESTOR3E 
REST0R39 
RESTOK*Q 
REST OK*l 
REST GR*2 
RESTOR*3 
RESTGR4* 
GWT13 d 
R£STGR*o 
REST 0R*7 
REST 0R*b 
REST GR*9 
RESTORSO 
RESTOR51 
REST OKS2 
REST GRB3 
REsTOK5h 
GWT13 9 
G NT 1 3 10 
RESTGR56 
REST GR59 
SAVER 3 
SAVER 5 
SAVER 6 
SAVER 7 
SAVER 6 
SAVtR 9 
SAVcR 10 
SAVER 11 
MISC 2 


I 

(JO 

I 


INTEGER ERFLAG,FERR,ACTION,PRTFIL 
EQUIVALENCE ( PRTFIL ,FERR) 

COMMON /FILES/ BASIC, MTAPE , FINAL , SI ,S2 
INTEGER BASIC, MTAPE, FINAL, St, S2 

COMMON /NAMES/ I VER,ONAME( 21 , MOONAHt 2) , BNAME ( 2) 

INTcGcR DNAMcMODNAM, BNAME 

COMMON /R£ST/TABLE,US£S,FILE,ENO,OECK,ODECK,SLANK , BATCH 

INTEGER TABLE, USES, FILE, END , DECK , OOtCK, BLANK, BATCH 

IU(1) = 5 

IR( 1) = 2 

IR(Z) - 2 

IK( 3) = 2 

WRITE (PRTFIL, 5) 

5 FORMATU9H cNTeR SAVE OPTION (DATA BASE, GORCA OR MOO DECO 
*/9H READY - ) 

CALL INCO ( KARO , 6) 

IF(KARD( 1) .EQ.6H0ATA 6) GO TO 13 
IF(KARD(1) .EQ.6H00RCA ) GO TO 23 
IF(KAROll) .EQ.6HM00 DE ) GO TO 30 
WRITE (PRTFIL, 16) 

16 FORMATION COMMAND NOT UNUcRSTOOO - PLEASt RtTRY ) 

RETURN 
10 CONTINUE 

IF (BASIC . N£. 1) GO TO 6 
WRITE (PRTFIL,?) 

7 FORMA T ( 31H FILE DOES NOT NEED TO 8c SAVED) 

RETURN 

6 CONTINUE 

WRITc (PRTFIL, 6) 

8 FORMAT ( 29H ENTER VERSION I DENT IF IER/ 9H READY - ) 

CALL INCD (ACTION, 5) 

IU(1) = 5 
IU ( 2) = BASIC 
XU ( 3) = % 

CALL INT3UF (IU, IR) 

IVtR = ACTION ( 1) 


MISC 3 
M1SC 4 
FILES 2 
FILES 3 
NAMES 2 
NAMES 3 
REST 2 
REST 3 
SAVER 16 
SAVER 17 
SAVER 18 
SAVcR 19 
SAVcR 20 
SAVER 21 
SAVER 22 
SAVER 23 
SAVcR Zh 
SAVER 20 
SAVcR 26 
SAVcR 27 
SAVER 26 
SAVER 29 
SAVcR 30 
SAVER 31 
SAVER 32 
SAVER 33 
SAVER 3* 
SAVcR 3» 
SAVcR 3o 
SAVER 37 
SAVER 38 
SAVER 39 
SAVER *» 0 
SAVER 41 
SAVER *»2 
SAVER *3 



I 

-0 

*>■ 

I 


CALL LABLtRClVcR, BASIC ,4) 


SAVtR 44 


RETURN 
2 0 CONTINUE 
FINAL - 14 
WRITt ( PRTFIL i 21) 

21 FORMAT ( *»6H ENTER NAME Of DECK TO BE USED FOR LORCA XNPUT/9H READY 

*- ) 

CALL INCO ( KARO y 5) 

IFUKARDU) .tQ.BNAMcd >) .AND. (KAR0C2) . EQ. 6NAME (2) > ) GO TO hQ 
IF(bNAMcd) .EC. G) GO TO 36 
37 WRITE (PRTFILj 39) 

39 FORMA T{ 1 8H DECK IS NOT DASIC/29H OESTROCT PERMISSION RbQUiRtG/ 
*loH cNTtR YcS OR N0/9H READY - ) 

CALL lNCO( ACTION, 5) 

IF(ACTIONd) • EQ. 2HN0) RETURN 
IF( ACTIONd) .NE.3HYES) GO TO 37 
33 CONTINUE 


SAVER 

SAVcR 

SAVER 

SAVER 

SAVER 

SAVER 

SAVtR 

SAVtR 

SAVER 

SAVER 

SAVcR 

SAVtR 

SAVER 

SAVER 

SAVER 

SAVtR 


4 3 

•*6 

•♦7 

46 

4 9 

S3 

3i 

52 

5S 

34 

55 

5 6 
57 

5 a 
59 

6 J 


ACT IONC 1) = KARO (1) 

ACTIONd) = KARO ( 2) 

CALL USE (ACTION) 

AO CONTINUE 

RtWlNO FINAL 

iud) = 5 

IU ( 2) = FINAL 

IU ( 3) = 12 

CALL INTBUF(IU,IR) 

REWIND 12 
REWINO FINAL 

22 CALL INCU (KARO, FINAL) 

IF (cRFLAG.Nc.C) RcT URN 
IF (KARO (1) .tQ.DDECK) GO TO 22 
IF(KAR0(1) • EQ. END) GO TO 23 
CALL 0UTCU(KARD,12) 

GO TO 22 

2 3 CONTINUE 

QNAME ( 1 ) = ACTIONd) 


SAVER 61 
SAVER o 2 
SAVER d 3 
SAVcR 64 
SAVER 65 
SAVER 6b 
SAVtR 67 
SAVtR ob 
SAVER ob 
SAVER 70 
SAVER 71 
SAVER 72 
SAVER 73 
SAVER 74 
SAVER 7s 
SAVER 7o 
SAVER 77 
SAVER 78 
SAVER 7i 



■ 

-J 

Ul 

I 


DNAME (2) = ACT 1 0N( 2) 


SA VEk dO 


REWIND 12 
RETURN 
30 CONTINUE 

WRITE ( PRT FIL, 51) 

51 FORMAT ( *»3H ENTER NAME OF DECK TO 02 SAVtD 
CALL INCO (ACTION, 5) 

IF ( ( ACT 1 ON ( 1 ) .EQ.MQDNAM(l) ) .AND. (ACTI0M2) 
WRITE (PRTFIL, 52) 

52 FORMAT ( 2*,H DECK NAMES 00 NOT MATCH/23H MOu 
♦15H RcQUcST OuNItO) 

ERFLAG = 1 
RETURN 
60 CONTINUE 
IU(1) = 13 
IU(2) = 2*+ 

CALL INTdUFdU, IR) 

Ml = 2 h 


SAVER 

SAVtk 

SAVER 

SAVER 

AS MOO UEUK/9H READY - I SAVER 

SAVtk 

• EQ. MOD NAM (2) > ) GO TO 60SAVER 

SAVER 

DECK NOT AVAILABLE/ SAVER 

SAVER 
SAVER 
d AVER 
SA VtR 
SAVER 
SAVER 
SAVER 
SAVtR 


dl 

82 

63 

6h 

6o 

do 

57 

66 

d9 

90 

91 

92 

93 
9-* 
95 
9o 
97 


RtWlNO Ml 
M2 = 13 
REWIND M 2 

65 CALL INCO (KARO, M2) 

IF(ERFLAG.Nt.O) RETURN 
CALL OOTCO (KARO, Ml) 

IF(KARU( 1) .Nt.ENO) GO TO 06 

RETURN 

END 

*EET,I DORMAN. SYNC 6 F 

SUBROUTINE SYNCBF ( 8 OF 1 , NC 1 , NL1 , FI LEI 

* ISYN1, 

* 0UF2,NC2,NL2,FILE2 
COMMON /OOFFEk/ MAX 

INTcGcR BUF1, BUF2, FILE 1 , FIE c 2 
COMMON / OFRS/ 

* ISYN(2,2C> 

DIMENSION dUF 1(14,20) , BUF2 ( 1*, 20 ) 



SAVER 96 
SAVER 99 
SAVER100 
SAVtklOl 
SAVER102 
SAVER103 

NS Y NC 1 , 

SAVfcRIQ* 
SAVER105 
SAVERlOo 
SYNCBFM3 
SYNCBF M5 

NSYnC 2) 

SYNCBFMo 
S YNC6FM7 


S YNCBFMd 
S YNCBFM9 
d YNCDF1Q 
SYNCBF 11 
SYNC8F12 
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INTEGER END 
C 

C NCCil - FIRST CARO IN BUFFER 1 

C NCC21 - FIRST CARD IN BUFFER 2 

C 

C NCC1 - NCC2 CUR Re. NT CARD BEING CONSIDERED 

C NLL 1 - NLL2 NR OF CARDS IN BUFFER 

C NC81 - NCB2 PRESENT INDEX IN BUFFER 

C ISYNl - INDEX TO THE SYNC CARDS 

C 

NCC 11= NCI 
NCC21= NC2 
NFLG1 = D 
NFLG2 = 0 
NCC 1 = 1 
NCC2 = 1 
NLL 1 = NL1 
NLL 2 = NL2 
NCB1 = 1 
NCB2 = 1 

NSYN1 = ISYN(1 f ISYN1) -NCI + i 
NSYN2 = ISYN(2 ,ISYN1) -NCZ + 1 
GO TO 70 
10 CONTINUE 

IF ( 8UF2 ( 1 t NLL2) .Nfc*6HSEND 0) GO TO 30 
15 NSYNC1 = NCC1 

NSYNC2 = NCC 2 

CALL RE STOP ( 8UF1,NC1,NLL1 » FILE l,NCCil) 

CALL RLSTOR(BUF2,NC2»NLL2, FILE2,NCC21> 

RETURN 

30 IF ( IFLG2 *EO*l) GO TO 15 

CALL FlLa'JF(l,END,MAX,BUF2 ,FILE2) 

NCC21 = NCC21 + NLL 2 
NCC2 = NCC 21 - NC2 ♦ 1 
NLL2 = END 
NCB2 = 1 


SYNCBF13 
S YNCbFlt 
SYNCBFls 
SYNCBFlb 
SYNG6F17’ 
SVNCBFlel 
SYNC6F19 
SYNCBF2ii 
SYNCBF21 
SYNCBF22 
SYNCBF23 
SYNCBF2‘* 
GMT 13 11 
GWT13 12 
GHT13 13 
SYNC8F2t> 
S YNC8F27 
SYNCBF28 
SYNCBF29 
SYNC6F30 
SYNCBF31 
SYNCBF32 
GMT13 1* 
GMT13 15 
GMT 13 lo 
GMT13 17 
GHT13 Hi 
GWT13 19 
GHT13 20 
GMT 13 21 
GHT13 22 
GHT13 23 
GMT 13 2 <♦ 
GMT 13 25 
GMT13 2o 
GMT 13 27 
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CALL KESTORIBUFI, NC 1 , NLL1 , FILE 1 , NCC 11) 

GWT13 28 


NCC 11 = NCI 

GMT13 23 


NCB1 = 1 

GWT13 30 


. NCC1 = 1 

GWT13 31 


NLL 1 = NL1 

&MT13 32 


IFLG1 = 0 

GMT13 33 


GO TO hO 

GWT13 3*» 

40 

CONTINUl 

GMT13 35 


00 «*5 I = 1,14 

GWT13 36 


IF(6UF1 (I,NC61> .NE.8UF2( I,NCB2) ) GO TO 50 

GMT13 37 

45 

CONTINUE 

GHT13 36 


GO TO 15 

G MT 1 3 39 

50 

NCB2 = NC62 + 1 

GWT13 *G 


NCC 2 = NCC2 + 1 

GMT 13 41 


IF ( NSYN2 .NE.NCC2) GC TO 55 

GMT 13 *2 


IFLG2 = 1 

GWT13 43 


GO TO 60 

GWT13 ** 

55 

IF( NC82 . LT • NLL2i GO TO hQ 

GWT13 *p 

60 

CONTlNUt 

GWT13 40 


NCB 1 = NCt)l + 1 

GHT13 4 7 


NCC 1 = NCC 1 + 1 

GWT13 48 


IF(NSYNl.NE.NCCl) GO TO 65 

GWT13 **9 


IFLG1 = 1 

GWT13 50 


GO TO 10 

GWT13 p1 

65 

1FCNC61 .LT.NLL1) GO TO 85 

GWT13 52 

70 

IF ( BUF1 ( 1 » NLL1 ) »Nc»cH$tND O) GO TO 60 

GWT13 53 


GO TO 10 

GWT13 54 

80 

CONTINUE 

GWT13 55 


CALL FILaUF(l,EN0,MAX,3UFl , FILED 

GWT13 56 


NCB 1 = 1 

GMT13 57 


NCC 11 = NCC11 + NLL 1 

GMT 13 58 


NCC 1 = NCC 1 1 - NCI + 1 

GMT 13 59 


NLL 1 = END 

GHT13 60 

85 

CALL RtST0RCBUF2,NCC21 ,NLL2 ,FILE2,NCC21) 

GMT13 61 


NCB 2 = 1 

GWT13 62 


NCC2 = NCC21 * NC2 + 1 

GHT13 o3 



o o o 


IFLG2 = 0 
GO TO 40 
£NO 

*ELT,I DORMAN. SYNCOS 

SUBROUTINE SYNCUS (FSYNi 
COMMON /3FRS/ I6YN(2,20> 
INTEGER F$YN,KAR0(16) , ITMP(lb) 

READ IN SYNC CAROS 


i 

-j 

00 

i 


DIMENSION IUNT (3) , 1RW( 3) 

IUNT ( 1) =FS YN 
IUNT ( 2) = 0 
IUNT ( 3) = 0 
IR W { 1) = 0 
IRWC2) = 13 
IRW { 3 ) = I 
00 1 1 = 1,20 
00 4 J= 1 , 2 
ISYN < J, I) = 100000 
H CONTlNUc 

1 CONTINUE 

CALL INT8UFUUNT, IRW) 

WRITE (t>, 1001 

1013 FORMAT (17H INPUT SYNC CAROS) 

JO 2 1=1,20 

1015 CONTINUE 

WRITc (6,110) 

1113 FORMAT ( 9H READY - ) 

CALL INCD (KARD,FSYN) 

IF(KARO(l) .EQ.4HOGNE) GO TO 3 
ENCODE (8*t,62, ITMP) (KARD(J) ,J=1,14) 
62 FORMAT (l*At>) 

□£COOE( 80, 6-4, ITMP) KAkD 
6*. FORMATtdtAojA**)) 

CALL VALUE (KARO , A, IERR) 


GHT13 64 
GHT13 66 
SVNC813 
SYNCDS 
SYNODS ? 
SYNCDS b 
SYNCDS 7 
SYNCDS b 
SYNCDS 9 
SYNCOS1Q 
SYNCDS1 1 
SYNCOS12 
SYNCOS13 
SYNC OS l 4 * 
S YNCCSib 
S YNCDS16 
SYNC0S17 
SYNCDSli 
SYNCOSld 
SYNCDS2Q 
S YNCOS21 
S YNCDS22 
SYNC0S23 
SYNCDs2*t 
SYNCDS2:? 
SYNCDS26 
SYNCDS27 
SYNCDS 2d 
SYNC0S29 
SYNC033U 
S YNCDS31 
SYNC0S32 
SYNCDS 3 3 
SYNC0S3 4 * 
SYNCDS 36 
SYNCOSJb 


ir\ to 



n o o 


-0 

■vD 

I 


IF(ItRR.GT.O) GO TO 520 
ISYN ( 1, I) = A 

CALL VALUE { KARO ( 3) » A, IERR) 

IF< IcRR.GT . 0) GO TO 520 
ISYN(2,I) = A 
GO TO 17 
-5 20 CONTINUE 

HRITc (6,533) 

530 FORMAT ( 3 7H UAO NUMERIC ENTRY - PLEASE REDO CARO) 

GO TO 1C5 
17 CONTINUE 

2 CONTINUc 

3 CONTINUE 
RE TURN 
END 

*ElT,I LiORMAN . SYNC1 

SUBROUTINE SYNC1 

COMMON /OFkj/ ISYN(2,2C) ,iSYNl» I Tl , IT2 , IT 3 , FULL , CN 1 , CN2 , L I N1 , HN2 
* , NW6UF ,NJl,Nb2,ICNl,ICN2 
COMMON / BFrS/ BUF1(14,50) , 3UF2 ( l* , 5 0 > , A AA < 7 <30 ) 

InTEGjlR C N 1 , CN 2 , B UF 1 , o UF 2 
LOGICAL FULL 

integer fini,fin2 

IN T EGER FOUT 
EQUIVALENCE (FIN1 , IT1) 

EQUIVALENCE (FIN2,IT2> 
cQU I VAL c NCc (FGUT,IT3) 

INTEGlK PkTFIL 
OATA PRTFIL/o/ 

FILES NOW OUT OF SYNC, RECOVER 

21 CONTINUE 

FULL = . TRUE. 

IF(CNl.cQ.t) GO TO 30 
J = i 


SYNCD;>37 
S YNCUS3S 
SYNC0S39 
SYNCDS«*Q 
SYNCDShI 
SYNC0b*2 
SYNGU3*3 
SYNCOSft 
SYNOGS*+:> 

5 YNCOS*tj 
SYNC OS 4 7 
S YNCDShO 
SYNCGSaB 

6 YNCOS5G 

S Y NCOS 51 
o YNC 1 3 

SYNC1 5 
BFRS1 2 
UFRS1 3 
bFRol * 
BFRil 5 
dFRSl o 
S Y NCI 7 
OYNC1 6 
SYNC1 5 
S YNt>l 10 
SYNCi 11 
SYNC1 12 
SYNCI 13 
SYNlI 1 y 
SYNCI lo 
SYNCI 17 
SYNCI 16 
SYNCI 19 
SYNCI 21 
SYNCI 22 



D O 2 'j l — C N 1 1 JSit5 1 
CO 22 I = 1 > 1 h 
22 3JFl(l, J)=3Uf 1(1,0 
2b J=J+1 

NJl = J - 1 
CM1 = 1 

IF { OUFi < 1 » Ndl J • EQ • 6H 32 NO 0) 60 TO 30 
2 3 CONTI Mj c. 

CALL FILoUF( J,Nbl,NWdUF,BUFl,FlNl) 

30 CONTINUE 

IF ( CN2 . £Q . 1 ) GO TO -»0 
J=1 

00 3b L=Cn2,(mu2 
DO 32 

32 dUF2(I, J)=GUF2 ( a ,L) 

35 J=J+1 

!4B2 = J - 1 
CU2 - 1 

• IF ( BUF2 t 1 » N02) » c.Q« 6 P$t NO 0) GO TO 40 

0 38 CONTINUE 

1 CALL FlLUUF < J , Nb2 ,N W3UF, 6UF2, FIN2> 

40 CONTINUE 

C 

C ATTEMPT TO HATCH IN BUFFER 
C 

13 CUNTINUE 

Ni = ICN1 - LIM * 1 
N2 = ICN2 - LIN2 *- 1 
Io=C 

Nd < = Ndl 

IF(NBX.GT.Nl) MlX = Nl 
Nut = N62 

IF(NdY*GT.N2) NoY = N2 
00 bQ K=CNl,NBX 
LL=K-CN1*CN2 
IF ( LL *0 T « N3 Y> LL = NdY 


GYNC1 23 
SYNC1 Zh 
GYNC1 2b 
GYNOl 26 
GHT13 ob 
GWT13 o7 
G HT 13 6b 
GWT13 69 
GYNC1 27 
GYNOl 29 
S Y NCI 31 
GYNCi 32 
GYNCI 33 
GYNCI 3t 
^YNCl 3? 
GYNCI 3b 
GWT13 7 ii 
GWT13 71 
GWT13 72 
GWT13 73 
GYNCI 37 
GYNCi 3‘* 
SYNG1 40 
SYNC1 41 
GYNCI 42 
GYNCI ■* 3 
GYNCI 44 
G Y N C 1 4 b 
G Y NO 1 40 
GYNCI 47 
SYNC1 46 
G Y NO 1 4 9 
GYNOl 50 
SYNC1 51 
GYnCI 52 
GYNOl o 3 



o o o 


DU $5 L=CN2,LL 

IFC6UF1 (1,K) .NE.3UF2C1 ,L>) GO TO 55 
DO 50 1=2,14 

IF(SUF1( I,K> .NE.3UF2 (1,L) > GO TO 55 
50 CONTINUE 
GO TO 70 
55 CONT IivUc 
60 CONTINUE 
K = N8X 
L = N6Y 
IS = 1 

70 CONTINUE 

DO 73 N=CN2 » Nb Y 
NN=N-CN2*CN1 
IF(NN.GT.NoX) NN = N3X 
DO 72 M=GN1,.NN 

IF ( BUF 1 ( 1 » li) . Nt . BUF2 (1 , N) ) GO TO 72 
DO 71 I = 2,14 

IF(BUF1(I«N)«N£.BJF2(Z»N)> GO TO 72 

71 CONTINUE 
GO TO 171 

72 CONTINUE 

73 CONTINUE 
M = N3X 
N = NBY 

IFCIS.EQ.0) GO TO 74 
Go TO 300 
171 CONTINUE 

IFICK+L) »Lc. (M+h) ) GO TO 7* 

L = N 
K = M 

7 h CONTINUE 

USc S V N CAROS 

IF< (K.LT.N1) .AND. CL. LT .N2) > GO TO 100 


oYNCl 

>4 

SYNCI 

55 

SYNC 1 

?o 

SYNLl 

57 

SYNCI 

6d 

S YNC 1 

5y 

SYNC1 

oO 

SYNCI 

Ql 

GWT13 

7-. 

GMT 13 

7y 

GMT13 

7 o 

SYNCI 

O'* 

dYNCl 

05 

SYNC 1 

GO 

6 YNC 1 

o7 

SYNC 1 

6b 

S Y NCI 

66 

i YNC 1 

7 0 

S YNC 1 

71 

SYNC! 

72 

GWT 

1 

SYNC1 

76 

SYNC1 

7-3 

GMT13 

77 

GMT13 

7 6 

synci 

di 

SYNC1 

d2 

gwt 

2 

GMT 

3 

GMT 

*» 

GMT 

5 

SYNCI 

d 3 

SYNCI 

d<+ 

SYNCI 

d5 

SYNoi 

do 

SYNCI 

d7 



n n o o r> o 


■ 

CO 

ro 

i 


C 

c 

c 


CALL CKSYN(ICNi,ICN2,iSYNl,l) 
100 CONTINUE. 

IF(K.N£.CN1> GO TO 60 

MUST UC iNStkT 

CALL iNStfiT <L+LIN2-CN2,0> 

RE TURN 


C 

C 

c 


MUST 00 DELE TE 


3CCONTiNUc 

CALL UcLCO (K-CNi+L INI) 

IF ( L. N£ . CN2) CALL INSERT < LIN2 +L -CN 2 , 1 > 

RE TURN 

300 CUNT I NU £ 

W R I T E (PRTFIL,9) 

9 FORMAT ( 54H THERE WILL 3£ A WAIT FOR OUT OF CORE SEARCH FOR 
CALL SYNC0F(6UFl,Ll M, NOl, FIN1 ,K,ISYN1, 

♦ bUF2,LiN2,NU2,FlN2,L> 

CALL SYNCBF(6UF2,LlN2,Nu2,FIN2,N t ISYNl f 

* EUFIjLIM, NdlfFlNl ,M* 

GO TO 171 

END 

*£LT,I DORMAN. UNPAC 

SUBROUTINE UNPAC(A,8,N> 

REMOVE = SIGNS AND REPLACE WITH BLANKS 
REMOVE J 

PROGRAMMER: VUIT 

COMMON /MISC/ERFLAG ,F£RR,KARO( l4> ,ACTIGN(14) 

INTlGlR £RFLAG,FtRR, ACTION, PRTFIL 
EQUIVALENCE ( PRTFI L , Ft RR) 

INTEGER A ( 8**) , B ( 84) 


MATCH! 


SVNC1 
SYNC 1 
SYNC1 
SYNC1 
SYNC 1 
SYNC1 
A.YNC1 
SYNC! 
SYNC 1 
SYNC1 
bYNCl 
SYNC1 
SYNC 11 00 
SYNCU01 
SY NCI 10 2 
SYNCH Q 3 
SYNCllO't 
SYNC 11 Op 
G WT*t 1 
GWT4 2 
GWT*» 3 
G WT 4 A 

SYNC 11 10 
SYNC1111 


86 

89 

90 

91 

92 

93 
9 * 
9p 
9b 
97 
9o 
99 


UNPAC 

UNPAC 

UNPAC 

UNPAC 

UNPAC 

UNPAC 

UNPAC 

UNPAC 

MISC 

MISC 

MISC 

UNPAC 


3 

i> 

o 

7 

a 

9 

10 

11 

2 

3 

4 

13 



no non 


ICHB = 1 
GO 10 1=1 , 64 
3(1) = 6 H 
10 CONTINUE 

00 100 1=1,64 
N = I 

IF (Ad) .cQ.lH*) KcTURN 
IF (Ad) • ECU 1 H= ) GO TO 70 
IF ( A ( I) 4 £Q . 1H ) GO TO 50 
IF(ICH8.GT.S4) GO TO 220 
BUCHti) = A(I) 

50 CONTINUE 

ICH3 = ICHQU 
IF (ICHB.GT.o*) RETURN 
GU TO 100 
70 CONTINUE 

^ IFdOHB.GT.71) GO TO 200 

w ICHd=ICH8tl 

' 90 I CH 3 =( (ICHti + 9) 710) *10 + 1 

130 CONTINUE 
GU TO 220 

ERROR EXIT 

200 CONTINUE 
2 20 CONTI NUn. 

*UITE (FcRR,3I0) A 

310 FGRRAT ( 2dH UNPAC - CARO IHAGl TOU LONG/ IX , 84 A 1 ) 
cKFLAG = 1 
CALL TtRN 
RETURN 
lNG 

c. L T , 1 OURMAN • U R c A 0 

GgOkCiUTINE UREAu dUNlT,ICRO) 

PROGRAMMlRS VOIT 


UNPAC 14 
UNPAC 15 
UNPAC lo 
UNPAC 17 
UNPAC Id 
UNPAC 19 
UNPAC 20 
UNPAC 21 
UNPAC 22 
UNPAC 23 
UNPAC 2* 
UNPAC lo 
UNPAC 2b 
UNPAC 27 
UNPAC 2d 
UNPAC 29 
UNPAC 30 
G wT 25 * 
UNPAC 31 
UNPrtC 32 
UNPAC 33 
UNPAC 3* 
UNPAC 3s> 
UNPAC 3o 
UNPAC 37 
UNPAC 3d 
UNPAC 39 
UNPAC -»0 
UNPAC 41 
UNPAC -»2 
UNPAC 43 
UNPAC 4-» 
ORE AO 3 
UR2AU 5 
UREAO o 
UREAO 7 



O o o o o 


c 

c 

DIMENSION ICRD(1*) 

R£AC (IUNiT,lO ,tNQ=2Q3 ,tRR=20Q> 
RETURN 

203 CONTINUE 

00 *t 0 I = 3 , 1 h 
ICRO(I) = 6H 
'<*0 CONTINUE 

ICRD(i) = 6H $ENu 0 
ICRO (2) = 6HF FILE 
RcTUjvN 

13 FORMAT ( 1 3Ao, A2) 
cNU 

FELT, I DORMAN. USER 

SUBROUTINE USER (IFLAG) 

CONTROLS FILES 

PROGRAMMER - S. WRAY 


URtAO & 
OREAO "si 
UREAO 1GI 

(ICKD(I) ,1=1, 1h) URtAO 1/ 

UREAO IS 
UREAO 20 
ORE AO 21 
UREAO 22 
UREAO 23 
UREAO 2*> 
ORE AO 2:> 
URtAO 2 o 
URtAO Z? 
UREAO 2d 
USER 3 
USER :> 
USER 6 
USER / 
USER <i 
USER S 
USER 10 
NAMES 2 
NAMtS 3 
FILtS 2 
FILES 3 
REST 2 
REST .3 
MISC 2 
MISC 3 
MISC 

USER IS 
USER 16 
USER 17 
USER lb 
USER IS 
USER 23 


COMMON / NAMcS/ I Vt R , 0 N AME ( 2 > , MOON AM ( 2 ) , BNAME ( 2 ) 

INTEGER ONAME, MOONAM, BNAME 

COMMON /FILEi/ BASIC, MTAPE, FINAL, 51, S2 
INT c. Gc.R BASIC, MT APt » FINAL, SI ,S2 

COMMON /KtST/TABLE, USES, FILE, END, DECK, DOECK, BLANK .BATCH 
INTEGER TABLE, USES, F ILt » END , DECK, OCECK, BLANK, BATCH 
COMMON /MlSC/tRFLAG,FiRR,KARO(l«,) ,ACTICN(1A) 

INTEGER erflag, ferr, action, prtfil 
EQUIVALENCE ( PRT F IL , FE RR) 

OIMcNSION I U ( 3 ) , IR ( 3) 

OATA 1U.IR/0, 0,0,2,2,27 
IF(IFLAG.EQ.C) WRITE (PRTFIL, 5 ) 

5 FORMAT ( 25H CREATE OPTION IS 3L0CKE0) 

WRITE (PRTFIL, lu) 

10 FORMAT ( 31H IF YOU WISH TO HAVE A DECK EXTRACTED FROM THE BANK/ 



<+9H ENTER THE NAME OF THE OtCK* OTHt RWlSt ENTtR D0Nt/9H RtAGY - 

) UStR 

21 

CALL INCD (ACTION, 5) 


USER 

22 

IF (ACTIGN(l) • tQ.'.HOONE) RETURN 


USER 

23 

IF ( ( ACTION (1) • EQ.MOONAM (1) ) .ANO. (ACTION (2) , EQ. MOONAM< 2) ) ) 

GO TO 

15USER 

2*t 

IF ( ( ACT 1 0 N( 1) .EQ.BNAME ( 1) ) . ANO. ( ACT I0N(2) .tQ.BNAMc (2) ) ) RtTURN 

UStR 

2? 

FINAL = 1* 


USER 

2© 

CALL USE (ACTION) 


USER 

22 

RETURN 


USER 

26 

Ml = 13 


USER 

29 

FINAL = 1* 


USER 

30 

10(1) = Ml 


USER 

31 

IU(2) = FINAL 


USER 

32 

CALL xN T 6UF ( IU , 1R) 


USER 

33 

REWlNu Ml 


USER 

3* 

CALL lNCO(KAkD,Mi) 


USER 

3 5 

IF((KAR0(3) .EO.dNAHE(l)) .AND. (KARO (6) .t0.oNAME(2))) GO TO 

20 

USER 

3o 

BNAMt(l) = KARO ( 5> 


USER 

37 

dNAME (2 ) = KARO (6) 


USER 

36 

CALL USc ( 3 N A M t ) 


USER 

3* 

CONTINUE 


UStR 

•♦0 

M2 = 23 


UStR 

•d 

IU(1) = Ml 


USER 

*2 

IU ( 2 ) = M2 


UStR 

•♦3 

IU ( 3 ) = FINAL 


UStR 

t*t 

CALL INTBUFUU, IR) 


USER 


RE RING Ml 


UUtk 

*+o 

REWIND M2 


UStR 

*♦7 

Re WIND F INAL 


USER 

*»6 

CALL EDITOR (f INAL, Ml, M2) 


USER 

49 

REWIND M2 


UStR 

50 

REWIND FINAL 


UStR 

51 

CALL INCD (KAKD ,M2) 


USER 

52 

IF(ERFLAG.NE.C) RETURN 


USER 

53 

CALL OUTCJ (KAkO, FINAL) 


UiER 

5w 

IF(KARDil) .NE.ENO) GO TO 25 


UStR 

35 

3NAME ( 1 ) = ACT ION ( 1 ) 


USER 

56 




SNArtc (2 ) = ACTI0N(2) 



USEk 

6 7 


RETURN 



USER 

36 


END 



USER 

39 

F £ 

LT,I GORMAN. VALJc 



VALUc 

3 


SUBROUTINE VALUc (A,V,I£R*) 



VALUE 

3 

c 

CONVERTS NUMERIC DATA FROM CODED TO FLOATING POINT FORMAT 

• 


value 

o 

c 

UPON ENTRY, A IS A ••2-CELL ARRAY CONTAINING COUtU VAlUE iN 

( Ab , 

A*) 

VALUE 

1 

c 

FORMAT, 1-1 Q DIGITS LQCATcQ ANY WHc Rc IN 10-CHARACTER 

FIcLO 

• 

VALUE 

a 

c 

DECIMAL POINT OPTIONAL* NO EXPONENTS OR ♦ UR - jIGNb* 

NO 


VALUE 

9 

c 

Blanks embedded between digits* 



VALUE 

10 

c 

UPON EXIT, V contains converted value in floating point. 

ickk 

IS 

avalue 

11 

c 

error flag— - 



VALUE 

1,2 

c 

IcRK - £ FOR NO ERROR. 



value 

IS 

c 

IcRR - -1 FUR COMPLETELY BLANK FIELD 



value 

1** 

c 

IlRR = 1,2,**»,1G INDICATES POSITION OF ILLEGAL CHARACTER 

9 

value 

In 

c 

MULTIPLE DECIMAL POINTS, OR cMbEQOcO BLANKS* 



value 

16 

c 




value 

17 


INTEGER Ail) , C ( 19) , CL ( 10) , P ( 2) 



VALUc 

16 


DATA C/19MH / 



VALUE 

19 


DATA CL / 1 HO , 1H1, 1H2 , 1H 3 , 1H*»,1H5, lHb, 1H7 , 1H 6 , 1H9/ 



VALUE 

2 L 

c 




value 

21 

c 

STORE CHARACTERS iNUlVluUALLY IN C(l0)-b<19> 



VALUc 

22 

c 




VALUE 

23 


DECODE (6,70, Ail) ) ICC I) , I = 1C, 15) 



VALUc 

2* 


DECODE U,7Q,A(2) ) (C( I) ,1 = 16, 19) 



VALUE 

23 

c 




VALUE 

2o 

c 

FIND POSITION OF FInST AND LAST NON-BLANK CHARACTER^ 



VALUE 

27 

c 




VALUE 

2 b 


NF = 1 Q 0 



VALUE 

29 


NL - 0 



VALUc 

30 


DO 10 1=10,19 



VALUc 

31 


IF (C(i) *EQ. 1H > GO TO 1C 



VALUE 

32 


MF=HINC ( I,NF) 



VALUc 

33 


NL= I 



VALUc 

3* 

10 

CONTINUE 



VALUE 

33 


IF (NL.GT.0) GO TO 20 



VALUc 

3d 



I 

00 

-0 

I 



IcRR=-l 


v aloe 

37 


GO TO bO 


V ALUc 

36 

c 



VALUt 

3 y 

c 

CHtCK F uR ILLEGAL CHAr v ACTERb, INCLUDING EMetOOtu 

OLANKb OR 

MUlTIPL VALUt 

*♦0 

c 

DECIMAL POINTS 


value 

41 

c 



VALDt 


zo 

NOP-G 


vALUt 

*3 


00 50 1=NF,NL 


VALUE 



00 30 J = 1 , 10 


value 



IF lC(I> .EQ.CL(J) J GO TO 50 


VALUt 


30 

CONTlNUt 


value 

h7 


IF (C(I> « N t * 1 H . ) GO Tu *»0 


value 

-to 


N0P=NJP+1 


VALUt 

*9 


IF ( NOP . E j . 1 i GO TO 50 


VALUt 

3 G 

<*G 

IERR=I-9 


VALUE 

si 


GO TU c 0 


VALUE 

*2 

50 

CONTINUE 


VALUt 

33 

c 



VALUE 


c 

REPACK CHARACTtkb RICH T-AUJUi TEU IN FIELD OF 10 

CrtARACTtRb. 

VALUE 

33 

c 



VALUt 

3b 


Nl=NL-9 


VALUt 

*7 


tNCOOt (10,70, P> (CCI) ,I = N1,NL) 


VALUt 

3 6 


JtCOOc (13,3CfP) V 


VALUE 

3* 


IERR= 0 


VALUE 

o J 

EG 

CONTINUE 


VALUE 

Ol 


RE TURN 


VAlUE 

t>2 

70 

FORMAT (10A1) 


value 

o3 

8C 

FORMAT (F10.0) 


VALUt 

o*t 


END 


VALUt 

03 

tc.LT, 

I OORMAN»ZEBRA 


ZtBKA 

3 

t FOR , 

b DORMAN .BLOCK, . BLOCK 


ZEBRA 

* 

FFOR, 

$ DORMAN. DORMAN, . DORMAN 


ZtBKA 

3 

*FGR, 

S DORMAN. REPL, . RtPL 


ZEBRA 

0 

*FOR, 

b DORMAN .UbER, .UbER 


ZtBKA 

7 

FFOR, 

S DORM AN . b A Vck, • SA VE R 


ZEBRA 

6 

FFOR, 

b DORMAN . ADDER, .ADDER 


ZtBKA 

9 



/FOR ji 5 

DORMAN • OELt T , • DELc. T 

ZtBRA 10 

/FOR, .> 

OORMAN.EOITER, ,£DITt« 

ZEBRA 11 

/FOR <i 3 

DORMAN. CONV, .CCNV 

ZEBRA 12 

/FORpS 

OORMAN.OPT, .OPT 

ZEBRA 13 

/F OR ], 3 

JORHAN. INORT, . XNCRT 

ZtBRA I 4 

/F JR ji 3 

DORMAN . ACDX, . AUOX 

ZtBRA 13 

FFOR -i S 

DCRMaN.TERM, .T tRM 

ZEBRA 16 

tF OR ji 3 

OGKMAN .LISTER, .LI 3 TER 

ZEBRA 17 

/FOR,, 3 

DORMAN .AlTAfc, .AlTAo 

ZEBRA 16 

/FOR, 3 

OOKMAN. A6TA1, . A6TA1 

ZEBRA 1 9 

tF OR i S 

DORMAN. CL03E, .CLOSE 

ZEBRA 2u 

/FOR,, 3 

OORMAN . A3SGN, . AS SON 

ZEBRA 21 

/FOR, 3 

DORMAN .OIFOEC , .QIFOEC 

ZEBRA 22 

/FOR <, 3 

DORMAN. FILOUF, .FlLBUF 

ZEBRA 23 

/FOR ,3 

OORMAN . FND8UF , .FN03UF 

ZEBRA 2‘, 

tF OR , 3 

OORMAN. INCO, . IN.CD 

ZEBRA 2:> 

/FOR ,3 

DORMAN. IiJTBUF , . I NT tiUF 

ZEBRA 2o 

/FOR, 3 

DORMAN .LABLtR, .L ABLER 

ZEBRA 27 

tFOR,S 

DORMAN. LORD, .LORD 

ZtBRA 26 

tF OR , S 

OURMAN . OUTGO, .OUTCD 

ZEBRA 20 

/F OR , 3 

DORMAN. PACCON, .PACCON 

ZEBRA SO 

tF 'JR , 3 

OORMAN. RE3TGR, .RESTOR 

ZEBRA 31 

/F Oft , 5 

OORMAN. SYNC6F, .SYNCdF 

ZEBRA 3,2 

/FOR, 3 

OORMAN. UNPAC, .UNPAC 

ZtBRA 33 

/FOR , S 

DORMAN .UREAO, .OREAD 

ZEBRA 34 

/FOR, 3 

OORMAN .GETGEN, .GETGEN 

ZEBRA 3? 

/FOR, 3 

OORMAN. LISIG, .LI5TG 

ZEBRA 3o 

/FOR, 3 

DORMAN. LISTTC, .LISTTC 

ZtBRA 37 

/ FOR, 3 

DORMAN.USE, .USE 

ZEBRA 36 

/FOR, 3 

OORMAN. ADD, .ADD 

ZtBRA 39 

/FOR, S 

OORMAN. REPLAC, .REPLAC 

ZtBRA *0 

/FOR, 3 

DORMAN. DELETE, .OELETE 

ZEBRA 4 1 

/FOR, 3 

DORMAN. COUNT, .COUNT 

ZEBRA *,2 

/FOR, 3 

OORMAN. EOITOK, .tDITDK 

ZEBRA 43 

/FOR, 3 

DORMAN. VALUE, .VALUE 

ZEBRA 44 

/FOR, 3 

DORMAN. SYNODS, .SYNCDS 

ZtBRA 4 j» 



o o o o 


*FOR,S DORMAN. SYNC1, .SYNC1 
/FOR, 3 DORMAN .OELCu, . DELCC 
#FOR,3 UOKMAN. INSERT, .INSERT 
*FOR»:> DORMAN . CKSYN, .CKSYN 
*FOR,S DORMAN. EXTRAN, .EXTRAN 
FELT, I DORMAN. USE 

SUBROUTINE USE < NAME) 

C PROGRAMMER - B. GOLD 

DIMENSION NAME(Z) ,KG(2G> 

DIMENSION IU ( 3 ) ,IR( 3) 

InTcGcR OUT 

COMMON /Ml SC/ERFL AG, FERR, KARO ( 1-*) , ACTION (iA) 

INTEGER ERFLAG , Ft REACTION, PRT FI L 
EQUIVALENCE IPRTFIL, FERR) 

COMMON /FILES/ bASI C ,M T APE , FI NAL , SI , S2 
INTEGER BASIC, MT A PE, FINAL, SI, S2 

COMMON /REST/TABLE, UScS, FILE, END, DECK, LutCK, BLANK , BATCH 
INTcGtR TABLl, USES , FILc , lNO , Dc CK , UDcCK , bL A NK, BA TCH 
COMMON /NAMES/ I VE R, ONAMc ( 2 > , MUDNAM ( 2) , dNAME ( 2) 

INTEGER CNAME, ilOuNAM, BNAME • 

INTEGER YES, NO 
iNTcGtR WORD 
INTLGcR VERS 
DATA VtkS /SHVEkSIO/ 

DATA Y£S,NO/3H Y£S,2HNU/ 

SI AND S2 ARE SCRATCH TAPES 

MT APE IS THc TAPE ONTO WHICH THE MOD DECKS ARE COPIED 


SI - 25 


S2 = 2b 


MT A PE = 

27 

IU<1) = 

BASIC 

IU { 2) = 

SI 

10 ( 3 ) = 

MT APE 

IR ( 1) = 

2 


ZcBRA 


ZEBRA 

+ 7 

ZtdRA 

4d 

ZEBRA 

“♦“J 

ZcBRA 


USE 

3 

USc 

3 

USE 

O 

USc 

7 

USE 

d 

USE 

9 

RISC 

2 

M ISC 

3 

MISC 


FILES 

2 

FILES 

3 

REST 

2 

RcST 

3 

NAMES 

2 

NAMES 

3 

UbE 

1* 

USE 

lb 

USE 

io 

USE 

1/ 

USc. 

Id 

USE 

19 

USE 

2u 

USE 

21 

USE 

22 

USE 

23 

USc 

2** 

Udc 

2 3 

USE 

2o 

USE . 

27 

USE 

2d 

USc 

29 



oooo noon 


Ik ( 2) = 2 

I R ( 3 ) = 2 

CAlL IN t BUF (iu, IR) 

EkFLAG = 0 
Kc. WIND BASIC 
REWIND mTAPc 
RE WIN J FINAL 
NG = 0 
LASTM = 0 
LASTS = 0 
NAMEl = NAME(l) 

NAMt2 = N AMt ( 2 ) 

IFlG = 1 
NTC = 0 

READ TABLE OF CONTENTS. STORE LIST OF ALL DECKS ON BAiiC FILE IN 
ARRAY TC. STORt GENcALOGY OF OcCK NAME IN ARRAY G. 

10 CALL- INCOTKARD, BASIC) 

IF ( ERFL AG »Nc . 0 ) RETURN 
IFCKARU (5) .EQ.VcRS) GO TO 10 
IF (KARu(l) .EU.ENO) GO TO 20 

NTC = NTCfl 

IF <KAR0(4) .EC. BLANK) LASTS = NTC 
IF (KAxOU) .EQ.UStS) LASTM = NTC 

IF < (KAR0C2) .Nt.NAMcl) .OR. <KAR0(3) .NE.NAME2)) GO TO 10 
NG — NG + 1 
KG(NG) = NTC 
NAMtl = KARU(5> 

NAME2 = KARO(o) 

GO TO 10 

Rt AO MUD OcCKS FROM BASIC FILE. IF REQUIRED FOR DECK NAME, STORE 
MOD DECK ON MTAPE, 

20 NDcCK = 0 


USE 

30 

USE 

31 

OSE 

32 

USE 

33 

USE 

3*» 

USE 

3:# 

USE 

3d 

USE 

32 

USE 

3d 

USE 

3 i 

USc 

*♦!) 

USE 

tl 

USE 

**2 

Uac 

43 

USc 


UoE 

4i? 

UoE 

*♦6 

USE 


USc 


OSE 


USE 

50 

USt 

51 

USE 

52 

USE 

53 

USE 

5* 

USE 

5> 

USE 

56 

USE 

5/ 

USt 

5d 

USE 

59 

USE 

60 

USc 

61 

USE 

62 

USc 

63 

Uic 

6* 

USE 

65 



nnoo oooo 


IF (NAMtl.Nt. BLANK) GO TO 200 
IFLG = 2 

IF (NG.EQ.l) GO TO 50 
IG = NG-1 

30 NOtCK = NDECK+1 

IF (NOtCK. GT.NTC) GO TO 220 
INDEX = LASTM - KG(IG) + 1 
WORD=NO 

IF(INOEX.EQ.NOECK) hORO=YES 
>+0 CALL INCO ( KARO , 6 ASI C) 

IF(tRFLAG.Nt.O) RETURN 

IF (WORQ.EQ. YcS) CALL OUTCO (KARO,MTAP£) 

IF (KARO(l) .Nt.tNG) GO TO *0 
IF (WOKD.EQ.NO > GO TO 30 
IG = IG - 1 

IF (IG.GT.0) GO TG 30 

ALL NOD OtCKS RcQUIRtO FOR DECK NAME HAVE BtEN PLACED ON MT APE . 
NOW FIND THE BASIC DECK REQUIRED. 

50 IFLG = 3 

INDEX = c ASTB - (KG (NG ) -LASTM) + 1 
55 NJECK - NDECK+1 

IF ( NDECK.GT .NTC) GO TO 220 
IF (NOtCK. EQ. INDEX) GO TO 70 
60 CALL INCO(KAKO, BASIC) 

IF (ERFLAG.Nt.G) RETURN 
IF (KAku(l) -END) 60,55,60 

BASIC FILt IS NOW POSITIONED AT BEGINNING OF BASIC DECK REQUIRED. 
COMBINED OtCKS VIA EDIT, 

70 IFlG = -4 

REWIND MTAPE 
REWIND FINAL 
BNAME(l) = NAME ( 1) 


iSt 

6o 

ISt 

67 

S£ 

66 

St 

69 

S£ 

70 

S£ 

71 

Sc 

72 

SE 

73 

SE 

7 h 

SE 

75 

SE 

76 

SE 

77 

it 

76 

St 

79 

SE 

60 

SE 

61 

SE 

62 

SE 

63 

SE 

6*» 

St 

6 5 

St 

6o 

SE 

67 

SE 

66 

St 

69 

St 

9U 

SE 

91 

SE 

92 

SE 

93 

St 

9 4 

SE 

9s 

St 

9b 

St 

97 

SE 

96 

SE 

99 

Sc 

100 

St 

101 



o o o 


I 

nD 

ro 
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BNAMt (2 ) = NAM t ( 2) 


USE 

102 

IF (NG.GT.l) GO TO 90 


USE 

103 

IU ( 2) =FINAl 


USE 

ItK 

CALL INTBUFdU, 1R) 


USt 

10» 

SCI CALL lNCO(KARO, BASIC) 


USE 

lflb 

IF ( lRFLAG • Nt « C ) RET URN 


USE 

10? 

CALL OUTGO (KARO, FINAL) 


USE 

lOd 

IF (KARO( 1) .tU.tNU) RtTURN 


USE 

109 

GO TO aC 


USE 

110 

9(1 IN = BASIC 


USE 

111 

OUT = SI 


USt 

112 

IG = NG 


USE 

113 

100 IG = IG-1 


USE 

1 l^ff 

IF (IG.tQ.i) OUT = FINAL 


USE 

11 si 

RtWlNO OUT 


USE 

llo 

IU(1) = IN 


USE 

11? 

IU ( 2) = MTAPE 


USE 

lift 

I J t 3) = OUT 


USt 

119 

CALL lNrB'JF(IU,iR) 


USE 

12 u 

CALL EUITOK ( I N, HTA Ft, GUT) 


USE 

121 

IF(ERFLAG.NE.C) RETURN 


Uit 

122 

IF (IG.tQ.i) RtTURN 


USE 

123 

IN = OUT 


USE 

12*, 

OUT = S2 


uSt 

12» 

IF (lN.Ea.S2) OUT = SI 

- 

USt 

12t> 

RtWlNQ IN 


USE 

127 

GO TO 100 


USE 

120 



USE 

129 

ERROR STOPS 


USt 

130 



USt 

131 

200 WRITE (F£RR,21C) NAMtl, NAME2, 

NAME 

Uit 

132 

210 FORMAT (2bHCC0ULu NOT FIND OtCK 

NAMtO *2A6,Z0H* RcOUIRtU FOR OtCK 

t USt 

133 

*2A6) 


USE 

13-* 

ERFLAG = 1 


USE 

13:? 

RETURN 


USE 

13o 

223 WRITc (FcRR,230) NAME 


USE 

137 



23 0 FORMAT ( 36H 0 iNDt XI NG cRRUR IN USt 
ERFLAG = 1 
Rt TURN 
END 


FOk OtCK NAHtD 2A6> 

USE 

13o 


USE 

139 


USE 

IhO 


USt 

1*1 


sO 

00 

1 



